--- loncom/lonnet/perl/lonnet.pm 2007/03/28 00:12:58 1.852
+++ loncom/lonnet/perl/lonnet.pm 2007/04/03 17:51:50 1.858
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.852 2007/03/28 00:12:58 albertel Exp $
+# $Id: lonnet.pm,v 1.858 2007/04/03 17:51:50 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -145,12 +145,12 @@ sub logperm {
}
sub create_connection {
- my ($server) = @_;
+ my ($hostname,$lonid) = @_;
my $client=IO::Socket::UNIX->new(Peer => $perlvar{'lonSockCreate'},
Type => SOCK_STREAM,
Timeout => 10);
return 0 if (!$client);
- print $client ("$server\n");
+ print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n");
my $result = <$client>;
chomp($result);
return 1 if ($result eq 'done');
@@ -185,7 +185,7 @@ sub subreply {
if($client) {
last; # Connected!
} else {
- &create_connection(&hostname($server));
+ &create_connection(&hostname($server),$server);
}
sleep(1); # Try again later if failed connection.
}
@@ -1516,8 +1516,12 @@ sub clean_filename {
# $coursedoc - if true up to the current course
# if false
# $subdir - directory in userfile to store the file into
-# $parser, $allfiles, $codebase - unknown
-#
+# $parser - instruction to parse file for objects ($parser = parse)
+# $allfiles - reference to hash for embedded objects
+# $codebase - reference to hash for codebase of java objects
+# $desuname - username for permanent storage of uploaded file
+# $dsetudom - domain for permanaent storage of uploaded file
+#
# output: url of file in userspace, or error: <message>
# or /adm/notfound.html if failure to upload occurse
@@ -1635,6 +1639,7 @@ sub finishuserfileupload {
' for embedded media: '.$parse_result);
}
}
+
# Notify homeserver to grep it
#
my $docuhome=&homeserver($docuname,$docudom);
@@ -1647,7 +1652,7 @@ sub finishuserfileupload {
&logthis('Failed to transfer '.$path.$file.' to host '.$docuhome.
': '.$fetchresult);
return '/adm/notfound.html';
- }
+ }
}
sub extract_embedded_items {
@@ -2069,11 +2074,16 @@ sub get_course_adv_roles {
}
sub get_my_roles {
- my ($uname,$udom,$types,$roles,$roledoms)=@_;
+ my ($uname,$udom,$context,$types,$roles,$roledoms)=@_;
unless (defined($uname)) { $uname=$env{'user.name'}; }
unless (defined($udom)) { $udom=$env{'user.domain'}; }
- my %dumphash=
+ my %dumphash;
+ if ($context eq 'userroles') {
+ %dumphash = &dump('roles',$udom,$uname);
+ } else {
+ %dumphash=
&dump('nohist_userroles',$udom,$uname);
+ }
my %returnhash=();
my $now=time;
foreach my $entry (keys(%dumphash)) {
@@ -4349,6 +4359,12 @@ sub courselog_query {
}
sub userlog_query {
+#
+# possible filters:
+# action: log check role
+# start: timestamp
+# end: timestamp
+#
my ($uname,$udom,%filters)=@_;
return &log_query($uname,$udom,'userlog',%filters);
}
@@ -6917,7 +6933,6 @@ sub getCODE {
sub rndseed {
my ($symb,$courseid,$domain,$username)=@_;
-
my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
if (!$symb) {
unless ($symb=$wsymb) { return time; }
@@ -7426,7 +7441,11 @@ sub hreflocation {
}
sub current_machine_domains {
- my $hostname=&hostname($perlvar{'lonHostID'});
+ return &machine_domains(&hostname($perlvar{'lonHostID'}));
+}
+
+sub machine_domains {
+ my ($hostname) = @_;
my @domains;
my %hostname = &all_hostnames();
while( my($id, $name) = each(%hostname)) {
@@ -7439,7 +7458,12 @@ sub current_machine_domains {
}
sub current_machine_ids {
- my $hostname=&hostname($perlvar{'lonHostID'});
+ return &machine_ids(&hostname($perlvar{'lonHostID'}));
+}
+
+sub machine_ids {
+ my ($hostname) = @_;
+ $hostname ||= &hostname($perlvar{'lonHostID'});
my @ids;
my %hostname = &all_hostnames();
while( my($id, $name) = each(%hostname)) {
@@ -7580,6 +7604,7 @@ sub goodbye {
}
BEGIN {
+
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
unless ($readit) {
{
@@ -7752,6 +7777,8 @@ sub get_dns {
{
my %iphost;
+ my %name_to_ip;
+ my %lonid_to_ip;
sub get_hosts_from_ip {
my ($ip) = @_;
my %iphosts = &get_iphost();
@@ -7760,10 +7787,23 @@ sub get_dns {
}
return;
}
+
+ sub get_host_ip {
+ my ($lonid) = @_;
+ if (exists($lonid_to_ip{$lonid})) {
+ return $lonid_to_ip{$lonid};
+ }
+ my $name=&hostname($lonid);
+ my $ip = gethostbyname($name);
+ return if (!$ip || length($ip) ne 4);
+ $ip=inet_ntoa($ip);
+ $name_to_ip{$name} = $ip;
+ $lonid_to_ip{$lonid} = $ip;
+ return $ip;
+ }
sub get_iphost {
if (%iphost) { return %iphost; }
- my %name_to_ip;
my %hostname = &all_hostnames();
foreach my $id (keys(%hostname)) {
my $name=$hostname{$id};
@@ -7779,6 +7819,7 @@ sub get_dns {
} else {
$ip = $name_to_ip{$name};
}
+ $lonid_to_ip{$id} = $ip;
push(@{$iphost{$ip}},$id);
}
return %iphost;
@@ -8116,6 +8157,10 @@ X<userenvironment()>
B<userenvironment($udom,$uname,@what)>: gets the values of the keys
passed in @what from the requested user's environment, returns a hash
+=item *
+X<userlog_query()>
+B<userlog_query($uname,$udom,%filters)>: retrieves data from a user's activity.log file. %filters defines filters applied when parsing the log file. These can be start or end timestamps, or the type of action - log to look for Login or Logout events, check for Checkin or Checkout, role for role selection. The response is in the form timestamp1:hostid1:event1×tamp2:hostid2:event2 where events are escaped strings of the action recorded in the activity.log file.
+
=back
=head2 User Roles
@@ -8145,16 +8190,18 @@ explanation of a user role term
=item *
-get_my_roles($uname,$udom,$types,$roles,$roledoms) : All arguments are
-optional. Returns a hash of a user's roles, with keys set to
-colon-sparated $uname,$udom,and $role, and value set to
-colon-separated start and end times for the role. If no username and
-domain are specified, will default to current user/domain. Types,
-roles, and roledoms are references to arrays, of role statuses
-(active, future or previous), roles (e.g., cc,in, st etc.) and domains
-of the roles which can be used to restrict the list if roles
-reported. If no array ref is provided for types, will default to
-return only active roles.
+get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
+All arguments are optional. Returns a hash of a roles, either for
+co-author/assistant author roles for a user's Construction Space
+(default), or if $context is 'user', roles for the user himself,
+In the hash, keys are set to colon-sparated $uname,$udom,and $role,
+and value is set to colon-separated start and end times for the role.
+If no username and domain are specified, will default to current
+user/domain. Types, roles, and roledoms are references to arrays,
+of role statuses (active, future or previous), roles
+(e.g., cc,in, st etc.) and domains of the roles which can be used
+to restrict the list of roles reported. If no array ref is
+provided for types, will default to return only active roles.
=back