[LON-CAPA-cvs] cvs: loncom(version_2_11_X) /lonnet/perl lonnet.pm

[raeburn]

raeburn		Wed May 27 17:11:32 2020 EDT

  Modified files:              (Branch: version_2_11_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - For 2.11
    Backport 1.1421, 1.1422 
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1172.2.123 loncom/lonnet/perl/lonnet.pm:1.1172.2.124
--- loncom/lonnet/perl/lonnet.pm:1.1172.2.123	Mon May  4 15:07:10 2020
+++ loncom/lonnet/perl/lonnet.pm	Wed May 27 17:11:31 2020
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.123 2020/05/04 15:07:10 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.124 2020/05/27 17:11:31 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3069,6 +3069,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)=@_;
@@ -3227,12 +3253,18 @@
                                     $stale = 1;
                                 }
                                 if ($stale) {
-                                    unlink($fname);
-                                    if ($uri!~/\.meta$/) {
-                                        unlink($fname.'.meta');
+                                    if (unlink($fname)) {
+                                        if ($uri!~/\.meta$/) {
+                                            if (-e $fname.'.meta') {
+                                                unlink($fname.'.meta');
+                                            }
+                                        }
+                                        my $unsubresult = &unsubscribe($fname);
+                                        unless ($unsubresult eq 'ok') {
+                                            &logthis("no unsub of $fname from $homeserver, reason: $unsubresult");
+                                        }
+                                        $removed = 1;
                                     }
-                                    &reply("unsub:$fname",$homeserver);
-                                    $removed = 1;
                                 }
                             }
                         }