version 1.852, 2007/03/28 00:12:58
|
version 1.858, 2007/04/03 17:51:50
|
Line 145 sub logperm {
|
Line 145 sub logperm {
|
} |
} |
|
|
sub create_connection { |
sub create_connection { |
my ($server) = @_; |
my ($hostname,$lonid) = @_; |
my $client=IO::Socket::UNIX->new(Peer => $perlvar{'lonSockCreate'}, |
my $client=IO::Socket::UNIX->new(Peer => $perlvar{'lonSockCreate'}, |
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Timeout => 10); |
Timeout => 10); |
return 0 if (!$client); |
return 0 if (!$client); |
print $client ("$server\n"); |
print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n"); |
my $result = <$client>; |
my $result = <$client>; |
chomp($result); |
chomp($result); |
return 1 if ($result eq 'done'); |
return 1 if ($result eq 'done'); |
Line 185 sub subreply {
|
Line 185 sub subreply {
|
if($client) { |
if($client) { |
last; # Connected! |
last; # Connected! |
} else { |
} else { |
&create_connection(&hostname($server)); |
&create_connection(&hostname($server),$server); |
} |
} |
sleep(1); # Try again later if failed connection. |
sleep(1); # Try again later if failed connection. |
} |
} |
Line 1516 sub clean_filename {
|
Line 1516 sub clean_filename {
|
# $coursedoc - if true up to the current course |
# $coursedoc - if true up to the current course |
# if false |
# if false |
# $subdir - directory in userfile to store the file into |
# $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> |
# output: url of file in userspace, or error: <message> |
# or /adm/notfound.html if failure to upload occurse |
# or /adm/notfound.html if failure to upload occurse |
|
|
Line 1635 sub finishuserfileupload {
|
Line 1639 sub finishuserfileupload {
|
' for embedded media: '.$parse_result); |
' for embedded media: '.$parse_result); |
} |
} |
} |
} |
|
|
# Notify homeserver to grep it |
# Notify homeserver to grep it |
# |
# |
my $docuhome=&homeserver($docuname,$docudom); |
my $docuhome=&homeserver($docuname,$docudom); |
Line 1647 sub finishuserfileupload {
|
Line 1652 sub finishuserfileupload {
|
&logthis('Failed to transfer '.$path.$file.' to host '.$docuhome. |
&logthis('Failed to transfer '.$path.$file.' to host '.$docuhome. |
': '.$fetchresult); |
': '.$fetchresult); |
return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
} |
} |
} |
} |
|
|
sub extract_embedded_items { |
sub extract_embedded_items { |
Line 2069 sub get_course_adv_roles {
|
Line 2074 sub get_course_adv_roles {
|
} |
} |
|
|
sub get_my_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($uname)) { $uname=$env{'user.name'}; } |
unless (defined($udom)) { $udom=$env{'user.domain'}; } |
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); |
&dump('nohist_userroles',$udom,$uname); |
|
} |
my %returnhash=(); |
my %returnhash=(); |
my $now=time; |
my $now=time; |
foreach my $entry (keys(%dumphash)) { |
foreach my $entry (keys(%dumphash)) { |
Line 4349 sub courselog_query {
|
Line 4359 sub courselog_query {
|
} |
} |
|
|
sub userlog_query { |
sub userlog_query { |
|
# |
|
# possible filters: |
|
# action: log check role |
|
# start: timestamp |
|
# end: timestamp |
|
# |
my ($uname,$udom,%filters)=@_; |
my ($uname,$udom,%filters)=@_; |
return &log_query($uname,$udom,'userlog',%filters); |
return &log_query($uname,$udom,'userlog',%filters); |
} |
} |
Line 6917 sub getCODE {
|
Line 6933 sub getCODE {
|
|
|
sub rndseed { |
sub rndseed { |
my ($symb,$courseid,$domain,$username)=@_; |
my ($symb,$courseid,$domain,$username)=@_; |
|
|
my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser(); |
my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser(); |
if (!$symb) { |
if (!$symb) { |
unless ($symb=$wsymb) { return time; } |
unless ($symb=$wsymb) { return time; } |
Line 7426 sub hreflocation {
|
Line 7441 sub hreflocation {
|
} |
} |
|
|
sub current_machine_domains { |
sub current_machine_domains { |
my $hostname=&hostname($perlvar{'lonHostID'}); |
return &machine_domains(&hostname($perlvar{'lonHostID'})); |
|
} |
|
|
|
sub machine_domains { |
|
my ($hostname) = @_; |
my @domains; |
my @domains; |
my %hostname = &all_hostnames(); |
my %hostname = &all_hostnames(); |
while( my($id, $name) = each(%hostname)) { |
while( my($id, $name) = each(%hostname)) { |
Line 7439 sub current_machine_domains {
|
Line 7458 sub current_machine_domains {
|
} |
} |
|
|
sub current_machine_ids { |
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 @ids; |
my %hostname = &all_hostnames(); |
my %hostname = &all_hostnames(); |
while( my($id, $name) = each(%hostname)) { |
while( my($id, $name) = each(%hostname)) { |
Line 7580 sub goodbye {
|
Line 7604 sub goodbye {
|
} |
} |
|
|
BEGIN { |
BEGIN { |
|
|
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
unless ($readit) { |
unless ($readit) { |
{ |
{ |
Line 7752 sub get_dns {
|
Line 7777 sub get_dns {
|
|
|
{ |
{ |
my %iphost; |
my %iphost; |
|
my %name_to_ip; |
|
my %lonid_to_ip; |
sub get_hosts_from_ip { |
sub get_hosts_from_ip { |
my ($ip) = @_; |
my ($ip) = @_; |
my %iphosts = &get_iphost(); |
my %iphosts = &get_iphost(); |
Line 7760 sub get_dns {
|
Line 7787 sub get_dns {
|
} |
} |
return; |
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 { |
sub get_iphost { |
if (%iphost) { return %iphost; } |
if (%iphost) { return %iphost; } |
my %name_to_ip; |
|
my %hostname = &all_hostnames(); |
my %hostname = &all_hostnames(); |
foreach my $id (keys(%hostname)) { |
foreach my $id (keys(%hostname)) { |
my $name=$hostname{$id}; |
my $name=$hostname{$id}; |
Line 7779 sub get_dns {
|
Line 7819 sub get_dns {
|
} else { |
} else { |
$ip = $name_to_ip{$name}; |
$ip = $name_to_ip{$name}; |
} |
} |
|
$lonid_to_ip{$id} = $ip; |
push(@{$iphost{$ip}},$id); |
push(@{$iphost{$ip}},$id); |
} |
} |
return %iphost; |
return %iphost; |
Line 8116 X<userenvironment()>
|
Line 8157 X<userenvironment()>
|
B<userenvironment($udom,$uname,@what)>: gets the values of the keys |
B<userenvironment($udom,$uname,@what)>: gets the values of the keys |
passed in @what from the requested user's environment, returns a hash |
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 |
=back |
|
|
=head2 User Roles |
=head2 User Roles |
Line 8145 explanation of a user role term
|
Line 8190 explanation of a user role term
|
|
|
=item * |
=item * |
|
|
get_my_roles($uname,$udom,$types,$roles,$roledoms) : All arguments are |
get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) : |
optional. Returns a hash of a user's roles, with keys set to |
All arguments are optional. Returns a hash of a roles, either for |
colon-sparated $uname,$udom,and $role, and value set to |
co-author/assistant author roles for a user's Construction Space |
colon-separated start and end times for the role. If no username and |
(default), or if $context is 'user', roles for the user himself, |
domain are specified, will default to current user/domain. Types, |
In the hash, keys are set to colon-sparated $uname,$udom,and $role, |
roles, and roledoms are references to arrays, of role statuses |
and value is set to colon-separated start and end times for the role. |
(active, future or previous), roles (e.g., cc,in, st etc.) and domains |
If no username and domain are specified, will default to current |
of the roles which can be used to restrict the list if roles |
user/domain. Types, roles, and roledoms are references to arrays, |
reported. If no array ref is provided for types, will default to |
of role statuses (active, future or previous), roles |
return only active 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 |
=back |
|
|