[LON-CAPA-cvs] cvs: loncom / lond /auth lonracc.pm /publisher lonpublisher.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 26 Jul 2002 19:35:20 -0000
This is a MIME encoded message
--albertel1027712120
Content-Type: text/plain
albertel Fri Jul 26 15:35:20 2002 EDT
Modified files:
/loncom lond
/loncom/auth lonracc.pm
/loncom/publisher lonpublisher.pm
Log:
- Now have .subscription files, implemntation should be backward compatible and also should start migrating subscriptions over
- BUG#332
--albertel1027712120
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20020726153520.txt"
Index: loncom/lond
diff -u loncom/lond:1.83 loncom/lond:1.84
--- loncom/lond:1.83 Wed Jul 17 15:06:30 2002
+++ loncom/lond Fri Jul 26 15:35:20 2002
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.83 2002/07/17 19:06:30 stredwic Exp $
+# $Id: lond,v 1.84 2002/07/26 19:35:20 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -951,44 +951,13 @@
} elsif ($userinput =~ /^unsub/) {
my ($cmd,$fname)=split(/:/,$userinput);
if (-e $fname) {
- if (unlink("$fname.$hostid{$clientip}")) {
- print $client "ok\n";
- } else {
- print $client "not_subscribed\n";
- }
+ print $client &unsub($client,$fname,$clientip);
} else {
print $client "not_found\n";
}
# ------------------------------------------------------------------- subscribe
} elsif ($userinput =~ /^sub/) {
- my ($cmd,$fname)=split(/:/,$userinput);
- my $ownership=ishome($fname);
- if ($ownership eq 'owner') {
- if (-e $fname) {
- if (-d $fname) {
- print $client "directory\n";
- } else {
- $now=time;
- {
- my $sh;
- if ($sh=
- IO::File->new(">$fname.$hostid{$clientip}")) {
- print $sh "$clientip:$now\n";
- }
- }
- unless ($fname=~/\.meta$/) {
- unlink("$fname.meta.$hostid{$clientip}");
- }
- $fname=~s/\/home\/httpd\/html\/res/raw/;
- $fname="http://$thisserver/".$fname;
- print $client "$fname\n";
- }
- } else {
- print $client "not_found\n";
- }
- } else {
- print $client "rejected\n";
- }
+ print $client &subscribe($userinput,$clientip);
# ------------------------------------------------------------------------- log
} elsif ($userinput =~ /^log/) {
my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
@@ -1520,9 +1489,75 @@
Debug("Returning nouser");
return "nouser";
}
-
}
+sub addline {
+ my ($fname,$hostid,$ip,$newline)=@_;
+ my $contents;
+ my $found=0;
+ my $expr='^'.$hostid.':'.$ip.':';
+ $expr =~ s/\./\\\./g;
+ if ($sh=IO::File->new("$fname.subscription")) {
+ while (my $subline=<$sh>) {
+ if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;}
+ }
+ $sh->close();
+ }
+ $sh=IO::File->new(">$fname.subscription");
+ if ($contents) { print $sh $contents; }
+ if ($newline) { print $sh $newline; }
+ $sh->close();
+ return $found;
+}
+
+sub unsub {
+ my ($fname,$clientip)=@_;
+ my $result;
+ if (unlink("$fname.$hostid{$clientip}")) {
+ $result="ok\n";
+ } else {
+ $result="not_subscribed\n";
+ }
+ if (-e "$fname.subscription") {
+ my $found=&addline($fname,$hostid{$clientip},$clientip,'');
+ if ($found) { $result="ok\n"; }
+ } else {
+ if ($result != "ok\n") { $result="not_subscribed\n"; }
+ }
+ return $result;
+}
+
+sub subscribe {
+ my ($userinput,$clientip)=@_;
+ my $result;
+ my ($cmd,$fname)=split(/:/,$userinput);
+ my $ownership=&ishome($fname);
+ if ($ownership eq 'owner') {
+ if (-e $fname) {
+ if (-d $fname) {
+ $result="directory\n";
+ } else {
+ if (-e "$fname.$hostid{$clientip}") {&unsub($fname,$clientip);}
+ $now=time;
+ my $found=&addline($fname,$hostid{$clientip},$clientip,
+ "$hostid{$clientip}:$clientip:$now\n");
+ if ($found) { $result="$fname\n"; }
+ # if they were subscribed to only meta data, delete that
+ # subscription, when you subscribe to a file you also get
+ # the metadata
+ unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }
+ $fname=~s/\/home\/httpd\/html\/res/raw/;
+ $fname="http://$thisserver/".$fname;
+ $result="$fname\n";
+ }
+ } else {
+ $result="not_found\n";
+ }
+ } else {
+ $result="rejected\n";
+ }
+ return $result;
+}
# ----------------------------------- POD (plain old documentation, CPAN style)
=head1 NAME
Index: loncom/auth/lonracc.pm
diff -u loncom/auth/lonracc.pm:1.4 loncom/auth/lonracc.pm:1.5
--- loncom/auth/lonracc.pm:1.4 Thu Jan 17 14:25:31 2002
+++ loncom/auth/lonracc.pm Fri Jul 26 15:35:20 2002
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Access Handler for File Transfers
#
-# $Id: lonracc.pm,v 1.4 2002/01/17 19:25:31 harris41 Exp $
+# $Id: lonracc.pm,v 1.5 2002/07/26 19:35:20 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,8 +34,22 @@
use strict;
use Apache::Constants qw(:common :remotehost);
+use Apache::lonnet();
use Apache::File();
+sub subscribed {
+ my ($filename,$id) = @_;
+ my $found=0;
+ my $expr='^'.$id.':'.$Apache::lonnet::hostip{$id}.':';
+ $expr =~ s/\./\\\./g;
+ my $sh;
+ if ($sh=Apache::File->new("$filename.subscription")) {
+ while (my $subline=<$sh>) { if ($subline =~ /$expr/) { $found=1; } }
+ $sh->close();
+ }
+ return $found;
+}
+
sub handler {
my $r = shift;
my $reqhost;
@@ -55,7 +69,9 @@
my ($id,$domain,$role,$name,$ip)=split(/:/,$readline);
if ($name =~ /$reqhost/i) {
my $filename=$r->filename;
- if ((-e "$filename.$id") || ($filename=~/\.meta$/)) {
+ if ((-e "$filename.$id") ||
+ &subscribed($filename,$id) ||
+ ($filename=~/\.meta$/)) {
return OK;
} else {
$r->log_reason("$id not subscribed", $r->filename);
Index: loncom/publisher/lonpublisher.pm
diff -u loncom/publisher/lonpublisher.pm:1.84 loncom/publisher/lonpublisher.pm:1.85
--- loncom/publisher/lonpublisher.pm:1.84 Wed Jul 17 14:23:45 2002
+++ loncom/publisher/lonpublisher.pm Fri Jul 26 15:35:20 2002
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.84 2002/07/17 18:23:45 bowersj2 Exp $
+# $Id: lonpublisher.pm,v 1.85 2002/07/26 19:35:20 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -235,6 +235,38 @@
return $return_url
}
+sub get_subscribed_hosts {
+ my ($target)=@_;
+ my @subscribed;
+ my $filename;
+ $target=~/(.*)\/([^\/]+)$/;
+ my $srcf=$2;
+ opendir(DIR,$1);
+ while ($filename=readdir(DIR)) {
+ if ($filename=~/$srcf\.(\w+)$/) {
+ my $subhost=$1;
+ if ($subhost ne 'meta' && $subhost ne 'subscription') {
+ push(@subscribed,$subhost);
+ }
+ }
+ }
+ closedir(DIR);
+ my $sh;
+ if ( $sh=Apache::File->new("$target.subscription") ) {
+ &Apache::lonnet::logthis("opened $target.subscription");
+ while (my $subline=<$sh>) {
+ &Apache::lonnet::logthis("Trying $subline");
+ if ($subline =~ /(^\w+):/) { push(@subscribed,$1); } else {
+ &Apache::lonnet::logthis("No Match for $subline");
+ }
+ }
+ } else {
+ &Apache::lonnet::logthis("Un able to open $target.subscription");
+ }
+ &Apache::lonnet::logthis("Got list of ".join(':',@subscribed));
+ return @subscribed;
+}
+
sub publish {
my ($source,$target,$style)=@_;
@@ -931,56 +963,26 @@
# --------------------------------------------------- Send update notifications
-{
-
- my $filename;
-
- $target=~/(.*)\/([^\/]+)$/;
- my $srcf=$2;
- opendir(DIR,$1);
- while ($filename=readdir(DIR)) {
- if ($filename=~/$srcf\.(\w+)$/) {
- my $subhost=$1;
- if ($subhost ne 'meta') {
- $scrout.='<p>Notifying host '.$subhost.':';
- print $logfile "\nNotifying host '.$subhost.':'";
- my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
- $scrout.=$reply;
- print $logfile $reply;
- }
- }
+ my @subscribed=&get_subscribed_hosts($target);
+ foreach my $subhost (@subscribed) {
+ $scrout.='<p>Notifying host '.$subhost.':';
+ print $logfile "\nNotifying host ".$subhost.':';
+ my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
+ $scrout.=$reply;
+ print $logfile $reply;
}
- closedir(DIR);
-
-}
# ---------------------------------------- Send update notifications, meta only
-{
-
- my $filename;
-
- $target=~/(.*)\/([^\/]+)$/;
- my $srcf=$2.'.meta';
- opendir(DIR,$1);
- while ($filename=readdir(DIR)) {
- if ($filename=~/$srcf\.(\w+)$/) {
- my $subhost=$1;
- if ($subhost ne 'meta') {
- $scrout.=
- '<p>Notifying host for metadata only '.$subhost.':';
- print $logfile
- "\nNotifying host for metadata only '.$subhost.':'";
- my $reply=&Apache::lonnet::critical(
- 'update:'.$target.'.meta',$subhost);
- $scrout.=$reply;
- print $logfile $reply;
- }
- }
+ my @subscribedmeta=&get_subscribed_hosts("$target.meta");
+ foreach my $subhost (@subscribedmeta) {
+ $scrout.='<p>Notifying host for metadata only '.$subhost.':';
+ print $logfile "\nNotifying host for metadata only ".$subhost.':';
+ my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
+ $subhost);
+ $scrout.=$reply;
+ print $logfile $reply;
}
- closedir(DIR);
-
-}
# ------------------------------------------------ Provide link to new resource
--albertel1027712120--