--- loncom/lond 2005/02/08 17:58:42 1.278
+++ loncom/lond 2005/06/03 18:23:19 1.284
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.278 2005/02/08 17:58:42 albertel Exp $
+# $Id: lond,v 1.284 2005/06/03 18:23:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.278 $'; #' stupid emacs
+my $VERSION='$Revision: 1.284 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -472,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.
@@ -1409,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
@@ -1425,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";
@@ -1471,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=<FILE>;
+ foreach my $obsolete (@obsolete) {
+ if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; }
+ if($obsolete =~ m|(<copyright>)(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.
@@ -2318,6 +2360,61 @@ sub put_user_profile_entry {
}
®ister_handler("put", \&put_user_profile_entry, 0, 1, 0);
+# Put a piece of new data in hash, returns error if entry already exists
+# Parameters:
+# $cmd - The command that got us here.
+# $tail - Tail of the command (remaining parameters).
+# $client - File descriptor connected to client.
+# Returns
+# 0 - Requested to exit, caller should shut down.
+# 1 - Continue processing.
+#
+sub newput_user_profile_entry {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my ($udom,$uname,$namespace,$what) =split(/:/,$tail,4);
+ if ($namespace eq 'roles') {
+ &Failure( $client, "refused\n", $userinput);
+ return 1;
+ }
+
+ chomp($what);
+
+ my $hashref = &tie_user_hash($udom, $uname, $namespace,
+ &GDBM_WRCREAT(),"N",$what);
+ if(!$hashref) {
+ &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+ "while attempting put\n", $userinput);
+ return 1;
+ }
+
+ my @pairs=split(/\&/,$what);
+ foreach my $pair (@pairs) {
+ my ($key,$value)=split(/=/,$pair);
+ if (exists($hashref->{$key})) {
+ &Failure($client, "key_exists: ".$key."\n",$userinput);
+ return 1;
+ }
+ }
+
+ foreach my $pair (@pairs) {
+ my ($key,$value)=split(/=/,$pair);
+ $hashref->{$key}=$value;
+ }
+
+ if (untie(%$hashref)) {
+ &Reply( $client, "ok\n", $userinput);
+ } else {
+ &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+ "while attempting put\n",
+ $userinput);
+ }
+ return 1;
+}
+®ister_handler("newput", \&newput_user_profile_entry, 0, 1, 0);
+
#
# Increment a profile entry in the user history file.
# The history contains keyword value pairs. In this case,
@@ -2348,11 +2445,17 @@ sub increment_user_value_handler {
my @pairs=split(/\&/,$what);
foreach my $pair (@pairs) {
my ($key,$value)=split(/=/,$pair);
+ $value = &unescape($value);
# We could check that we have a number...
if (! defined($value) || $value eq '') {
$value = 1;
}
$hashref->{$key}+=$value;
+ if ($namespace eq 'nohist_resourcetracker') {
+ if ($hashref->{$key} < 0) {
+ $hashref->{$key} = 0;
+ }
+ }
}
if (untie(%$hashref)) {
&Reply( $client, "ok\n", $userinput);
@@ -3210,7 +3313,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 {
@@ -3226,6 +3329,11 @@ sub dump_course_id_handler {
} else {
$ownerfilter='.';
}
+ if (defined($coursefilter)) {
+ $coursefilter=&unescape($coursefilter);
+ } else {
+ $coursefilter='.';
+ }
unless (defined($since)) { $since=0; }
my $qresult='';
@@ -3256,6 +3364,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.'&';
}
@@ -4282,7 +4396,7 @@ sub ReadHostTable {
if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) {
my ($id,$domain,$role,$name)=split(/:/,$configline);
$name=~s/\s//g;
- my (undef,undef,undef,undef,$ip) = gethostbyname($name);
+ my $ip = gethostbyname($name);
if (length($ip) ne 4) {
&logthis("Skipping host $id name $name no IP $ip found\n");
next;
@@ -4427,8 +4541,6 @@ sub Reply {
Debug("Request was $request Reply was $reply");
$Transactions++;
-
-
}