--- loncom/lonnet/perl/lonnet.pm 2007/04/03 17:51:50 1.858 +++ loncom/lonnet/perl/lonnet.pm 2007/04/05 22:04:49 1.866 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.858 2007/04/03 17:51:50 raeburn Exp $ +# $Id: lonnet.pm,v 1.866 2007/04/05 22:04:49 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -734,16 +734,32 @@ sub idput { # ------------------------------------------- get items from domain db files sub get_dom { - my ($namespace,$storearr,$udom)=@_; + my ($namespace,$storearr,$udom,$uhome)=@_; my $items=''; foreach my $item (@$storearr) { $items.=&escape($item).'&'; } $items=~s/\&$//; - if (!$udom) { $udom=$env{'user.domain'}; } - if (defined(&domain($udom,'primary'))) { - my $uhome=&domain($udom,'primary'); + if (!$udom) { + $udom=$env{'user.domain'}; + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } else { + $uhome eq ''; + } + } else { + if (!$uhome) { + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } + } + } + if ($udom && $uhome && ($uhome ne 'no_host')) { my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); + my %returnhash; + if ($rep =~ /^error: 2 /) { + return %returnhash; + } my @pairs=split(/\&/,$rep); if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { return @pairs; @@ -756,17 +772,29 @@ sub get_dom { } return %returnhash; } else { - &logthis("get_dom failed - no primary domain server for $udom"); + &logthis("get_dom failed - no homeserver and/or domain"); } } # -------------------------------------------- put items in domain db files sub put_dom { - my ($namespace,$storehash,$udom)=@_; - if (!$udom) { $udom=$env{'user.domain'}; } - if (defined(&domain($udom,'primary'))) { - my $uhome=&domain($udom,'primary'); + my ($namespace,$storehash,$udom,$uhome)=@_; + if (!$udom) { + $udom=$env{'user.domain'}; + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } else { + $uhome eq ''; + } + } else { + if (!$uhome) { + if (defined(&domain($udom,'primary'))) { + $uhome=&domain($udom,'primary'); + } + } + } + if ($udom && $uhome && ($uhome ne 'no_host')) { my $items=''; foreach my $item (keys(%$storehash)) { $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; @@ -774,7 +802,7 @@ sub put_dom { $items=~s/\&$//; return &reply("putdom:$udom:$namespace:$items",$uhome); } else { - &logthis("put_dom failed - no primary domain server for $udom"); + &logthis("put_dom failed - no homeserver and/or domain"); } } @@ -1521,13 +1549,16 @@ sub clean_filename { # $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 +# $thumbwidth - width (pixels) of thumbnail to make for uploaded image +# $thumbheight - height (pixels) of thumbnail to make for uploaded image # # output: url of file in userspace, or error: # or /adm/notfound.html if failure to upload occurse sub userfileupload { - my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,$destudom)=@_; + my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname, + $destudom,$thumbwidth,$thumbheight)=@_; if (!defined($subdir)) { $subdir='unknown'; } my $fname=$env{'form.'.$formname.'.filename'}; $fname=&clean_filename($fname); @@ -1574,7 +1605,7 @@ sub userfileupload { if ($env{'form.folder'} =~ m/^(default|supplemental)/) { return &finishuserfileupload($docuname,$docudom, $formname,$fname,$parser,$allfiles, - $codebase); + $codebase,$thumbwidth,$thumbheight); } else { $fname=$env{'form.folder'}.'/'.$fname; return &process_coursefile('uploaddoc',$docuname,$docudom, @@ -1584,8 +1615,9 @@ sub userfileupload { } elsif (defined($destuname)) { my $docuname=$destuname; my $docudom=$destudom; - return &finishuserfileupload($docuname,$docudom,$formname, - $fname,$parser,$allfiles,$codebase); + return &finishuserfileupload($docuname,$docudom,$formname,$fname, + $parser,$allfiles,$codebase, + $thumbwidth,$thumbheight); } else { my $docuname=$env{'user.name'}; @@ -1594,16 +1626,18 @@ sub userfileupload { $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; } - return &finishuserfileupload($docuname,$docudom,$formname, - $fname,$parser,$allfiles,$codebase); + return &finishuserfileupload($docuname,$docudom,$formname,$fname, + $parser,$allfiles,$codebase, + $thumbwidth,$thumbheight); } } sub finishuserfileupload { - my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase) = @_; + my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase, + $thumbwidth,$thumbheight) = @_; my $path=$docudom.'/'.$docuname.'/'; my $filepath=$perlvar{'lonDocRoot'}; - my ($fnamepath,$file); + my ($fnamepath,$file,$fetchthumb); $file=$fname; if ($fname=~m|/|) { ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); @@ -1639,12 +1673,28 @@ sub finishuserfileupload { ' for embedded media: '.$parse_result); } } + if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { + my $input = $filepath.'/'.$file; + my $output = $filepath.'/'.'tn-'.$file; + my $thumbsize = $thumbwidth.'x'.$thumbheight; + system("convert -sample $thumbsize $input $output"); + if (-e $filepath.'/'.'tn-'.$file) { + $fetchthumb = 1; + } + } # Notify homeserver to grep it # my $docuhome=&homeserver($docuname,$docudom); my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); if ($fetchresult eq 'ok') { + if ($fetchthumb) { + my $thumbresult= &reply('fetchuserfile:'.$path.'tn-'.$file,$docuhome); + if ($thumbresult ne 'ok') { + &logthis('Failed to transfer '.$path.'tn-'.$file.' to host '. + $docuhome.': '.$thumbresult); + } + } # # Return the URL to it return '/uploaded/'.$path.$file; @@ -3540,9 +3590,16 @@ sub get_portfolio_access { } if (@users > 0) { foreach my $userkey (@users) { - if (exists($access_hash->{$userkey}{'users'}{$env{'user.name'}.':'.$env{'user.domain'}})) { - return 'ok'; - } + if (ref($access_hash->{$userkey}{'users'}) eq 'ARRAY') { + foreach my $item (@{$access_hash->{$userkey}{'users'}}) { + if (ref($item) eq 'HASH') { + if (($item->{'uname'} eq $env{'user.name'}) && + ($item->{'udom'} eq $env{'user.domain'})) { + return 'ok'; + } + } + } + } } } my %roleshash; @@ -7603,15 +7660,6 @@ sub goodbye { &logthis("Shutting down"); } -BEGIN { - -# ----------------------------------- Read loncapa.conf and loncapa_apache.conf - unless ($readit) { -{ - my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf'); - %perlvar = (%perlvar,%{$configvars}); -} - sub get_dns { my ($url,$func) = @_; open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); @@ -7646,10 +7694,14 @@ sub get_dns { $this_domain{$field} = shift(@elements); } $domain{$name} = \%this_domain; - &logthis("Domain.tab: $name ".$domain{$name}{'description'} ); } } - + + sub reset_domain_info { + undef($loaded); + undef(%domain); + } + sub load_domain_tab { &get_dns('/adm/dns/domain',\&parse_domain_tab); my $fh; @@ -7695,9 +7747,17 @@ sub get_dns { $hostdom{$id}=$domain; if ($role eq 'library') { $libserv{$id}=$name; } } - &logthis("Hosts.tab: $name ".$id ); } } + + sub reset_hosts_info { + &reset_domain_info(); + &reset_hosts_ip_info(); + undef(%hostname); + undef(%hostdom); + undef(%libserv); + undef($loaded); + } sub load_hosts_tab { &get_dns('/adm/dns/hosts',\&parse_hosts_tab); @@ -7708,9 +7768,6 @@ sub get_dns { $loaded=1; } - # FIXME: dev server don't want this, production servers _do_ want this - #&get_iphost(); - sub hostname { &load_hosts_tab() if (!$loaded); @@ -7787,6 +7844,12 @@ sub get_dns { } return; } + + sub reset_hosts_ip_info { + undef(%iphost); + undef(%name_to_ip); + undef(%lonid_to_ip); + } sub get_host_ip { my ($lonid) = @_; @@ -7806,7 +7869,7 @@ sub get_dns { if (%iphost) { return %iphost; } my %hostname = &all_hostnames(); foreach my $id (keys(%hostname)) { - my $name=$hostname{$id}; + my $name=&hostname($id); my $ip; if (!exists($name_to_ip{$name})) { $ip = gethostbyname($name); @@ -7826,6 +7889,16 @@ sub get_dns { } } +BEGIN { + +# ----------------------------------- Read loncapa.conf and loncapa_apache.conf + unless ($readit) { +{ + my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf'); + %perlvar = (%perlvar,%{$configvars}); +} + + # ------------------------------------------------------ Read spare server file { open(my $config,"<$perlvar{'lonTabDir'}/spare.tab"); @@ -8159,7 +8232,13 @@ passed in @what from the requested user' =item * X -B: 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. +B: 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 @@ -8626,12 +8705,15 @@ critical subroutine =item * -get_dom($namespace,$storearr,$udomain) : returns hash with keys from array -reference filled in from namespace found in domain level on primary domain server ($udomain is optional) +get_dom($namespace,$storearr,$udom,$uhome) : returns hash with keys from +array reference filled in from namespace found in domain level on either +specified domain server ($uhome) or primary domain server ($udom and $uhome are optional). =item * -put_dom($namespace,$storehash,$udomain) : stores hash in namespace at domain level on primary domain server ($udomain is optional) +put_dom($namespace,$storehash,$udom,$uhome) : stores hash in namespace at +domain level either on specified domain server ($uhome) or primary domain +server ($udom and $uhome are optional) =back