version 1.858, 2007/04/03 17:51:50
|
version 1.863, 2007/04/04 00:10:15
|
Line 734 sub idput {
|
Line 734 sub idput {
|
# ------------------------------------------- get items from domain db files |
# ------------------------------------------- get items from domain db files |
|
|
sub get_dom { |
sub get_dom { |
my ($namespace,$storearr,$udom)=@_; |
my ($namespace,$storearr,$udom,$uhome)=@_; |
my $items=''; |
my $items=''; |
foreach my $item (@$storearr) { |
foreach my $item (@$storearr) { |
$items.=&escape($item).'&'; |
$items.=&escape($item).'&'; |
} |
} |
$items=~s/\&$//; |
$items=~s/\&$//; |
if (!$udom) { $udom=$env{'user.domain'}; } |
if (!$udom) { |
if (defined(&domain($udom,'primary'))) { |
$udom=$env{'user.domain'}; |
my $uhome=&domain($udom,'primary'); |
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 $rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { |
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { |
Line 756 sub get_dom {
|
Line 768 sub get_dom {
|
} |
} |
return %returnhash; |
return %returnhash; |
} else { |
} 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 |
# -------------------------------------------- put items in domain db files |
|
|
sub put_dom { |
sub put_dom { |
my ($namespace,$storehash,$udom)=@_; |
my ($namespace,$storehash,$udom,$uhome)=@_; |
if (!$udom) { $udom=$env{'user.domain'}; } |
if (!$udom) { |
if (defined(&domain($udom,'primary'))) { |
$udom=$env{'user.domain'}; |
my $uhome=&domain($udom,'primary'); |
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=''; |
my $items=''; |
foreach my $item (keys(%$storehash)) { |
foreach my $item (keys(%$storehash)) { |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
Line 774 sub put_dom {
|
Line 798 sub put_dom {
|
$items=~s/\&$//; |
$items=~s/\&$//; |
return &reply("putdom:$udom:$namespace:$items",$uhome); |
return &reply("putdom:$udom:$namespace:$items",$uhome); |
} else { |
} else { |
&logthis("put_dom failed - no primary domain server for $udom"); |
&logthis("put_dom failed - no homeserver and/or domain"); |
} |
} |
} |
} |
|
|
Line 1521 sub clean_filename {
|
Line 1545 sub clean_filename {
|
# $codebase - reference to hash for codebase of java objects |
# $codebase - reference to hash for codebase of java objects |
# $desuname - username for permanent storage of uploaded file |
# $desuname - username for permanent storage of uploaded file |
# $dsetudom - domain for permanaent 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: <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 |
|
|
|
|
sub userfileupload { |
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'; } |
if (!defined($subdir)) { $subdir='unknown'; } |
my $fname=$env{'form.'.$formname.'.filename'}; |
my $fname=$env{'form.'.$formname.'.filename'}; |
$fname=&clean_filename($fname); |
$fname=&clean_filename($fname); |
Line 1574 sub userfileupload {
|
Line 1601 sub userfileupload {
|
if ($env{'form.folder'} =~ m/^(default|supplemental)/) { |
if ($env{'form.folder'} =~ m/^(default|supplemental)/) { |
return &finishuserfileupload($docuname,$docudom, |
return &finishuserfileupload($docuname,$docudom, |
$formname,$fname,$parser,$allfiles, |
$formname,$fname,$parser,$allfiles, |
$codebase); |
$codebase,$thumbwidth,$thumbheight); |
} else { |
} else { |
$fname=$env{'form.folder'}.'/'.$fname; |
$fname=$env{'form.folder'}.'/'.$fname; |
return &process_coursefile('uploaddoc',$docuname,$docudom, |
return &process_coursefile('uploaddoc',$docuname,$docudom, |
Line 1584 sub userfileupload {
|
Line 1611 sub userfileupload {
|
} elsif (defined($destuname)) { |
} elsif (defined($destuname)) { |
my $docuname=$destuname; |
my $docuname=$destuname; |
my $docudom=$destudom; |
my $docudom=$destudom; |
return &finishuserfileupload($docuname,$docudom,$formname, |
return &finishuserfileupload($docuname,$docudom,$formname,$fname, |
$fname,$parser,$allfiles,$codebase); |
$parser,$allfiles,$codebase, |
|
$thumbwidth,$thumbheight); |
|
|
} else { |
} else { |
my $docuname=$env{'user.name'}; |
my $docuname=$env{'user.name'}; |
Line 1594 sub userfileupload {
|
Line 1622 sub userfileupload {
|
$docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
$docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
$docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
$docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
} |
} |
return &finishuserfileupload($docuname,$docudom,$formname, |
return &finishuserfileupload($docuname,$docudom,$formname,$fname, |
$fname,$parser,$allfiles,$codebase); |
$parser,$allfiles,$codebase, |
|
$thumbwidth,$thumbheight); |
} |
} |
} |
} |
|
|
sub finishuserfileupload { |
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 $path=$docudom.'/'.$docuname.'/'; |
my $filepath=$perlvar{'lonDocRoot'}; |
my $filepath=$perlvar{'lonDocRoot'}; |
my ($fnamepath,$file); |
my ($fnamepath,$file,$fetchthumb); |
$file=$fname; |
$file=$fname; |
if ($fname=~m|/|) { |
if ($fname=~m|/|) { |
($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); |
($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); |
Line 1639 sub finishuserfileupload {
|
Line 1669 sub finishuserfileupload {
|
' for embedded media: '.$parse_result); |
' 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 |
# Notify homeserver to grep it |
# |
# |
my $docuhome=&homeserver($docuname,$docudom); |
my $docuhome=&homeserver($docuname,$docudom); |
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); |
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); |
if ($fetchresult eq 'ok') { |
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 the URL to it |
return '/uploaded/'.$path.$file; |
return '/uploaded/'.$path.$file; |
Line 7603 sub goodbye {
|
Line 7649 sub goodbye {
|
&logthis("Shutting down"); |
&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 { |
sub get_dns { |
my ($url,$func) = @_; |
my ($url,$func) = @_; |
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
Line 7646 sub get_dns {
|
Line 7683 sub get_dns {
|
$this_domain{$field} = shift(@elements); |
$this_domain{$field} = shift(@elements); |
} |
} |
$domain{$name} = \%this_domain; |
$domain{$name} = \%this_domain; |
&logthis("Domain.tab: $name ".$domain{$name}{'description'} ); |
|
} |
} |
} |
} |
|
|
Line 7695 sub get_dns {
|
Line 7731 sub get_dns {
|
$hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
if ($role eq 'library') { $libserv{$id}=$name; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
} |
} |
&logthis("Hosts.tab: $name ".$id ); |
|
} |
} |
} |
} |
|
|
Line 7708 sub get_dns {
|
Line 7743 sub get_dns {
|
$loaded=1; |
$loaded=1; |
} |
} |
|
|
# FIXME: dev server don't want this, production servers _do_ want this |
|
#&get_iphost(); |
|
|
|
sub hostname { |
sub hostname { |
&load_hosts_tab() if (!$loaded); |
&load_hosts_tab() if (!$loaded); |
|
|
Line 7826 sub get_dns {
|
Line 7858 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 |
# ------------------------------------------------------ Read spare server file |
{ |
{ |
open(my $config,"<$perlvar{'lonTabDir'}/spare.tab"); |
open(my $config,"<$perlvar{'lonTabDir'}/spare.tab"); |
Line 8159 passed in @what from the requested user'
|
Line 8201 passed in @what from the requested user'
|
|
|
=item * |
=item * |
X<userlog_query()> |
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. |
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 |
|
|
Line 8626 critical subroutine
|
Line 8674 critical subroutine
|
|
|
=item * |
=item * |
|
|
get_dom($namespace,$storearr,$udomain) : returns hash with keys from array |
get_dom($namespace,$storearr,$udom,$uhome) : returns hash with keys from |
reference filled in from namespace found in domain level on primary domain server ($udomain is optional) |
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 * |
=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 |
=back |
|
|