[LON-CAPA-cvs] cvs: loncom /debugging_tools unsubresources.pl /lonnet/perl lonnet.pm

[raeburn]

raeburn		Wed May 13 17:44:11 2020 EDT

  Modified files:              
    /loncom/debugging_tools	unsubresources.pl 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Add &unsubscribe() subroutine, and use in place of lonnet::reply() in
    unsubresources.pl and in &remove_stale_resfile() in lonnet.pm 
  
  
Index: loncom/debugging_tools/unsubresources.pl
diff -u loncom/debugging_tools/unsubresources.pl:1.1 loncom/debugging_tools/unsubresources.pl:1.2
--- loncom/debugging_tools/unsubresources.pl:1.1	Wed May 13 01:49:55 2020
+++ loncom/debugging_tools/unsubresources.pl	Wed May 13 17:44:06 2020
@@ -10,7 +10,7 @@
 # nodes which are the home servers for the authors of the replicated
 # resources, in the event that the author publishes updated version(s).
 #
-# $Id: unsubresources.pl,v 1.1 2020/05/13 01:49:55 raeburn Exp $
+# $Id: unsubresources.pl,v 1.2 2020/05/13 17:44:06 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -117,7 +117,8 @@
     print "\n *** ".&mt('Running in a mode where changes will be made.')." ***\n";
     print "\n".
           &mt('Mode is [_1] -- replicated resources in [_2] will be unlinked and unsubscribed.',
-              "'$action'","'$londocroot/res/'")."\n";
+              "'$action'","'$londocroot/res/'")."\n".
+          &mt('Results will be logged in [_1].',"$londaemons/logs/unsubresources.log")."\n";
     print &mt('Continue? ~[y/N~] ');
     if (!&get_user_selection()) {
         exit;
@@ -236,7 +237,7 @@
                                 unlink("$dir/$item.meta");
                             }
                             if ($currhome ne '') {
-                                my $result = &Apache::lonnet::reply("unsub:$dir/$item",$currhome);
+                                my $result = &Apache::lonnet::unsubscribe("$dir/$item");
                                 if ($result eq 'ok') {
                                     print $fh &mt('Unsub complete for [_1] at [_2]',
                                                      "$dir/$item",$currhome)."\n";
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1421 loncom/lonnet/perl/lonnet.pm:1.1422
--- loncom/lonnet/perl/lonnet.pm:1.1421	Wed May 13 01:58:16 2020
+++ loncom/lonnet/perl/lonnet.pm	Wed May 13 17:44:10 2020
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1421 2020/05/13 01:58:16 raeburn Exp $
+# $Id: lonnet.pm,v 1.1422 2020/05/13 17:44:10 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3383,6 +3383,32 @@
     }
 }
 
+# ------------------------------------------------- Unsubscribe from a resource
+
+sub unsubscribe {
+    my ($fname) = @_;
+    my $answer;
+    if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return $answer; }
+    $fname=~s/[\n\r]//g;
+    my $author=$fname;
+    $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+    my ($udom,$uname)=split(/\//,$author);
+    my $home=homeserver($uname,$udom);
+    if ($home eq 'no_host') {
+        $answer = 'no_host';
+    } elsif (grep { $_ eq $home } &current_machine_ids()) {
+        $answer = 'home';
+    } else {
+        my $defdom = $perlvar{'lonDefDomain'};
+        if (&will_trust('content',$defdom,$udom)) {
+            $answer = reply("unsub:$fname",$home);
+        } else {
+            $answer = 'untrusted';
+        }
+    }
+    return $answer;
+}
+
 # ------------------------------------------------ Get server side include body
 sub ssi_body {
     my ($filelink,%form)=@_;
@@ -3534,7 +3560,10 @@
                                                 unlink($fname.'.meta');
                                             }
                                         }
-                                        &reply("unsub:$fname",$homeserver);
+                                        my $unsubresult = &unsubscribe($fname);
+                                        unless ($unsubresult eq 'ok') {
+                                            &logthis("no unsub of $fname from $homeserver, reason: $unsubresult");
+                                        }
                                         $removed = 1;
                                     }
                                 }