--- loncom/lond 2004/12/28 15:09:38 1.270 +++ loncom/lond 2005/04/12 00:19:59 1.282 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.270 2004/12/28 15:09:38 matthew Exp $ +# $Id: lond,v 1.282 2005/04/12 00:19:59 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,14 +58,13 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.270 $'; #' stupid emacs +my $VERSION='$Revision: 1.282 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; my $client; my $clientip; # IP address of client. -my $clientdns; # DNS name of client. my $clientname; # LonCAPA name of client. my $server; @@ -178,7 +177,6 @@ sub ResetStatistics { # $initcmd - The full text of the init command. # # Implicit inputs: -# $clientdns - The DNS name of the remote client. # $thisserver - Our DNS name. # # Returns: @@ -187,10 +185,10 @@ sub ResetStatistics { # sub LocalConnection { my ($Socket, $initcmd) = @_; - Debug("Attempting local connection: $initcmd client: $clientdns me: $thisserver"); - if($clientdns ne $thisserver) { + Debug("Attempting local connection: $initcmd client: $clientip me: $thisserver"); + if($clientip ne "127.0.0.1") { &logthis(' LocalConnection rejecting non local: ' - ."$clientdns ne $thisserver "); + ."$clientip ne $thisserver "); close $Socket; return undef; } else { @@ -474,39 +472,11 @@ sub CopyFile { my ($oldfile, $newfile) = @_; - # The file must exist: - - if(-e $oldfile) { - - # Read the old file. - - my $oldfh = IO::File->new("< $oldfile"); - if(!$oldfh) { - return 0; - } - my @contents = <$oldfh>; # Suck in the entire file. - - # write the backup file: - - my $newfh = IO::File->new("> $newfile"); - if(!(defined $newfh)){ - return 0; - } - my $lines = scalar @contents; - for (my $i =0; $i < $lines; $i++) { - print $newfh ($contents[$i]); - } - - $oldfh->close; - $newfh->close; - - chmod(0660, $newfile); - - return 1; - - } else { - return 0; + if (! copy($oldfile,$newfile)) { + return 0; } + chmod(0660, $newfile); + return 1; } # # Host files are passed out with externally visible host IPs. @@ -1411,6 +1381,9 @@ sub du_handler { ®ister_handler("du", \&du_handler, 0, 1, 0); # +# The ls_handler routine should be considered obosolete and is retained +# for communication with legacy servers. Please see the ls2_handler. +# # ls - list the contents of a directory. For each file in the # selected directory the filename followed by the full output of # the stat function is returned. The returned info for each @@ -1427,6 +1400,7 @@ sub du_handler { # The reply is written to $client. # sub ls_handler { + # obsoleted by ls2_handler my ($cmd, $ulsdir, $client) = @_; my $userinput = "$cmd:$ulsdir"; @@ -1473,6 +1447,72 @@ sub ls_handler { } ®ister_handler("ls", \&ls_handler, 0, 1, 0); +# +# Please also see the ls_handler, which this routine obosolets. +# ls2_handler differs from ls_handler in that it escapes its return +# values before concatenating them together with ':'s. +# +# ls2 - list the contents of a directory. For each file in the +# selected directory the filename followed by the full output of +# the stat function is returned. The returned info for each +# file are separated by ':'. The stat fields are separated by &'s. +# Parameters: +# $cmd - The command that dispatched us (ls). +# $ulsdir - The directory path to list... I'm not sure what this +# is relative as things like ls:. return e.g. +# no_such_dir. +# $client - Socket open on the client. +# Returns: +# 1 - indicating that the daemon should not disconnect. +# Side Effects: +# The reply is written to $client. +# +sub ls2_handler { + my ($cmd, $ulsdir, $client) = @_; + + my $userinput = "$cmd:$ulsdir"; + + my $obs; + my $rights; + my $ulsout=''; + my $ulsfn; + if (-e $ulsdir) { + if(-d $ulsdir) { + if (opendir(LSDIR,$ulsdir)) { + while ($ulsfn=readdir(LSDIR)) { + undef $obs, $rights; + my @ulsstats=stat($ulsdir.'/'.$ulsfn); + #We do some obsolete checking here + if(-e $ulsdir.'/'.$ulsfn.".meta") { + open(FILE, $ulsdir.'/'.$ulsfn.".meta"); + my @obsolete=; + foreach my $obsolete (@obsolete) { + if($obsolete =~ m|()(on)|) { $obs = 1; } + if($obsolete =~ m|()(default)|) { + $rights = 1; + } + } + } + my $tmp = $ulsfn.'&'.join('&',@ulsstats); + if ($obs eq '1') { $tmp.="&1"; } else { $tmp.="&0"; } + if ($rights eq '1') { $tmp.="&1"; } else { $tmp.="&0"; } + $ulsout.= &escape($tmp).':'; + } + closedir(LSDIR); + } + } else { + my @ulsstats=stat($ulsdir); + $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; + } + } else { + $ulsout='no_such_dir'; + } + if ($ulsout eq '') { $ulsout='empty'; } + &Reply($client, "$ulsout\n", $userinput); # This supports debug logging. + return 1; +} +®ister_handler("ls2", \&ls2_handler, 0, 1, 0); + # Process a reinit request. Reinit requests that either # lonc or lond be reinitialized so that an updated # host.tab or domain.tab can be processed. @@ -1799,10 +1839,11 @@ sub change_authentication_handler { # to take ownership of the construction space back to www:www # - if( ($oldauth =~ /^unix/) && ($umode eq "internal")) { # unix -> internal + if( (($oldauth =~ /^unix/) && ($umode eq "internal")) || + (($oldauth =~ /^internal/) && ($umode eq "unix")) ) { if(&is_author($udom, $uname)) { &Debug(" Need to manage author permissions..."); - &manage_permissions("/$udom/_au", $udom, $uname, "internal:"); + &manage_permissions("/$udom/_au", $udom, $uname, "$umode:"); } } @@ -3108,6 +3149,14 @@ sub reply_query_handler { # $tail - Tail of the command. In this case consists of a colon # separated list contaning the domain to apply this to and # an ampersand separated list of keyword=value pairs. +# Each value is a colon separated list that includes: +# description, institutional code and course owner. +# For backward compatibility with versions included +# in LON-CAPA 1.1.X (and earlier) and 1.2.X, institutional +# code and/or course owner are preserved from the existing +# record when writing a new record in response to 1.1 or +# 1.2 implementations of lonnet::flushcourselogs(). +# # $client - Socket open on the client. # Returns: # 1 - indicating that processing should continue @@ -3129,7 +3178,23 @@ sub put_course_id_handler { my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { foreach my $pair (@pairs) { - my ($key,$courseinfo) = split(/=/,$pair); + my ($key,$courseinfo) = split(/=/,$pair,2); + $courseinfo =~ s/=/:/g; + + my @current_items = split(/:/,$hashref->{$key}); + shift(@current_items); # remove description + pop(@current_items); # remove last access + my $numcurrent = scalar(@current_items); + + my @new_items = split(/:/,$courseinfo); + my $numnew = scalar(@new_items); + if ($numcurrent > 0) { + if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier + $courseinfo .= ':'.join(':',@current_items); + } elsif ($numnew == 2) { # flushcourselogs() from 1.2.X + $courseinfo .= ':'.$current_items[$numcurrent-1]; + } + } $hashref->{$key}=$courseinfo.':'.$now; } if (untie(%$hashref)) { @@ -3168,6 +3233,15 @@ sub put_course_id_handler { # description - regular expression that is used to filter # the dump. Only keywords matching this regexp # will be used. +# institutional code - optional supplied code to filter +# the dump. Only courses with an institutional code +# that match the supplied code will be returned. +# owner - optional supplied username of owner to filter +# the dump. Only courses for which the course +# owner matches the supplied username will be +# returned. Implicit assumption that owner +# is a user in the domain in which the +# course database is defined. # $client - The socket open on the client. # Returns: # 1 - Continue processing. @@ -3178,7 +3252,7 @@ sub dump_course_id_handler { my $userinput = "$cmd:$tail"; - my ($udom,$since,$description,$instcodefilter,$ownerfilter) =split(/:/,$tail); + my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter) =split(/:/,$tail); if (defined($description)) { $description=&unescape($description); } else { @@ -3194,6 +3268,11 @@ sub dump_course_id_handler { } else { $ownerfilter='.'; } + if (defined($coursefilter)) { + $coursefilter=&unescape($coursefilter); + } else { + $coursefilter='.'; + } unless (defined($since)) { $since=0; } my $qresult=''; @@ -3201,13 +3280,9 @@ sub dump_course_id_handler { if ($hashref) { while (my ($key,$value) = each(%$hashref)) { my ($descr,$lasttime,$inst_code,$owner); - if ($value =~ m/^([^\:]*):([^\:]*):([^\:]*):(\d+)$/) { - ($descr,$inst_code,$owner,$lasttime)=($1,$2,$3,$4); - } elsif ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) { - ($descr,$inst_code,$lasttime)=($1,$2,$3); - } else { - ($descr,$lasttime) = split(/\:/,$value); - } + my @courseitems = split(/:/,$value); + $lasttime = pop(@courseitems); + ($descr,$inst_code,$owner)=@courseitems; if ($lasttime<$since) { next; } my $match = 1; unless ($description eq '.') { @@ -3228,6 +3303,12 @@ sub dump_course_id_handler { $match = 0; } } + unless ($coursefilter eq '.' || !defined($coursefilter)) { + my $unescapeCourse = &unescape($key); + unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) { + $match = 0; + } + } if ($match == 1) { $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; } @@ -4251,12 +4332,18 @@ sub ReadHostTable { my $myloncapaname = $perlvar{'lonHostID'}; Debug("My loncapa name is : $myloncapaname"); while (my $configline=) { - if (!($configline =~ /^\s*\#/)) { - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - chomp($ip); $ip=~s/\D+$//; + if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) { + my ($id,$domain,$role,$name)=split(/:/,$configline); + $name=~s/\s//g; + my $ip = gethostbyname($name); + if (length($ip) ne 4) { + &logthis("Skipping host $id name $name no IP $ip found\n"); + next; + } + $ip=inet_ntoa($ip); $hostid{$ip}=$id; # LonCAPA name of host by IP. $hostdom{$id}=$domain; # LonCAPA domain name of host. - $hostip{$id}=$ip; # IP address of host. + $hostip{$id}=$ip; # IP address of host. $hostdns{$name} = $id; # LonCAPA name of host by DNS. if ($id eq $perlvar{'lonHostID'}) { @@ -4437,7 +4524,7 @@ sub logstatus { flock(LOG,LOCK_EX); print LOG $$."\t".$clientname."\t".$currenthostid."\t" .$status."\t".$lastlog."\t $keymode\n"; - flock(DB,LOCK_UN); + flock(LOG,LOCK_UN); close(LOG); } &status("Finished logging"); @@ -4668,8 +4755,6 @@ sub make_new_child { if (defined($iaddr)) { $clientip = inet_ntoa($iaddr); Debug("Connected with $clientip"); - $clientdns = gethostbyaddr($iaddr, AF_INET); - Debug("Connected with $clientdns by name"); } else { &logthis("Unable to determine clientip"); $clientip='Unavailable'; @@ -4709,18 +4794,23 @@ sub make_new_child { ReadManagerTable; # May also be a manager!! - my $clientrec=($hostid{$clientip} ne undef); - my $ismanager=($managers{$clientip} ne undef); + my $outsideip=$clientip; + if ($clientip eq '127.0.0.1') { + $outsideip=$hostip{$perlvar{'lonHostID'}}; + } + + my $clientrec=($hostid{$outsideip} ne undef); + my $ismanager=($managers{$outsideip} ne undef); $clientname = "[unknonwn]"; if($clientrec) { # Establish client type. $ConnectionType = "client"; - $clientname = $hostid{$clientip}; + $clientname = $hostid{$outsideip}; if($ismanager) { $ConnectionType = "both"; } } else { $ConnectionType = "manager"; - $clientname = $managers{$clientip}; + $clientname = $managers{$outsideip}; } my $clientok;