version 1.1021, 2009/08/22 21:11:19
|
version 1.1025, 2009/09/03 21:23:36
|
Line 92 use Time::HiRes qw( gettimeofday tv_inte
|
Line 92 use Time::HiRes qw( gettimeofday tv_inte
|
use Cache::Memcached; |
use Cache::Memcached; |
use Digest::MD5; |
use Digest::MD5; |
use Math::Random; |
use Math::Random; |
|
use File::MMagic; |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
|
Line 958 sub idput {
|
Line 959 sub idput {
|
} |
} |
} |
} |
|
|
# ------------------------------------------------ dump from domain db files |
# ------------------------------dump from db file owned by domainconfig user |
|
|
sub dump_dom { |
sub dump_dom { |
my ($namespace,$udom,$uhome,$regexp,$range)=@_; |
my ($namespace,$udom,$regexp,$range)=@_; |
if (!$udom) { |
if (!$udom) { |
$udom=$env{'user.domain'}; |
$udom=$env{'user.domain'}; |
if (defined(&domain($udom,'primary'))) { |
|
$uhome=&domain($udom,'primary'); |
|
} else { |
|
undef($uhome); |
|
} |
|
} else { |
|
if (!$uhome) { |
|
if (defined(&domain($udom,'primary'))) { |
|
$uhome=&domain($udom,'primary'); |
|
} |
|
} |
|
} |
} |
my %returnhash; |
my %returnhash; |
if ($udom && $uhome && ($uhome ne 'no_host')) { |
if ($udom) { |
if ($regexp) { |
my $uname = &get_domainconfiguser($udom); |
$regexp=&escape($regexp); |
%returnhash = &dump($namespace,$udom,$uname,$regexp,$range); |
} else { |
|
$regexp='.'; |
|
} |
|
my $rep=&reply("dumpdom:$udom:$namespace:$regexp:$range",$uhome); |
|
my @pairs=split(/\&/,$rep); |
|
foreach my $item (@pairs) { |
|
my ($key,$value)=split(/=/,$item,2); |
|
$key = &unescape($key); |
|
next if ($key =~ /^error: 2 /); |
|
$returnhash{$key}=&thaw_unescape($value); |
|
} |
|
} |
} |
return %returnhash; |
return %returnhash; |
} |
} |
|
|
# ------------------------------------------- get items from domain db files |
# ------------------------------------------ get items from domain db files |
|
|
sub get_dom { |
sub get_dom { |
my ($namespace,$storearr,$udom,$uhome)=@_; |
my ($namespace,$storearr,$udom,$uhome)=@_; |
Line 1069 sub put_dom {
|
Line 1047 sub put_dom {
|
} |
} |
} |
} |
|
|
# -------------------------------------- newput for items in domain db files |
# --------------------- newput for items in db file owned by domainconfig user |
|
|
sub newput_dom { |
sub newput_dom { |
my ($namespace,$storehash,$udom,$uhome) = @_; |
my ($namespace,$storehash,$udom) = @_; |
my $result; |
my $result; |
if (!$udom) { |
if (!$udom) { |
$udom=$env{'user.domain'}; |
$udom=$env{'user.domain'}; |
if (defined(&domain($udom,'primary'))) { |
|
$uhome=&domain($udom,'primary'); |
|
} else { |
|
undef($uhome); |
|
} |
|
} else { |
|
if (!$uhome) { |
|
if (defined(&domain($udom,'primary'))) { |
|
$uhome=&domain($udom,'primary'); |
|
} |
|
} |
|
} |
} |
if ($udom && $uhome && ($uhome ne 'no_host')) { |
if ($udom) { |
my $items=''; |
my $uname = &get_domainconfiguser($udom); |
if (ref($storehash) eq 'HASH') { |
$result = &newput($namespace,$storehash,$udom,$uname); |
foreach my $key (keys(%$storehash)) { |
|
$items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; |
|
} |
|
$items=~s/\&$//; |
|
$result = &reply("newputdom:$udom:$namespace:$items",$uhome); |
|
} |
|
} else { |
|
&logthis("put_dom failed - no homeserver and/or domain"); |
|
} |
} |
return $result; |
return $result; |
} |
} |
|
|
|
# --------------------- delete for items in db file owned by domainconfig user |
sub del_dom { |
sub del_dom { |
my ($namespace,$storearr,$udom,$uhome)=@_; |
my ($namespace,$storearr,$udom)=@_; |
if (ref($storearr) eq 'ARRAY') { |
if (ref($storearr) eq 'ARRAY') { |
my $items=''; |
|
foreach my $item (@$storearr) { |
|
$items.=&escape($item).'&'; |
|
} |
|
$items=~s/\&$//; |
|
if (!$udom) { |
if (!$udom) { |
$udom=$env{'user.domain'}; |
$udom=$env{'user.domain'}; |
if (defined(&domain($udom,'primary'))) { |
|
$uhome=&domain($udom,'primary'); |
|
} else { |
|
undef($uhome); |
|
} |
|
} else { |
|
if (!$uhome) { |
|
if (defined(&domain($udom,'primary'))) { |
|
$uhome=&domain($udom,'primary'); |
|
} |
|
} |
|
} |
} |
if ($udom && $uhome && ($uhome ne 'no_host')) { |
if ($udom) { |
return &reply("deldom:$udom:$namespace:$items",$uhome); |
my $uname = &get_domainconfiguser($udom); |
} else { |
return &del($namespace,$storearr,$udom,$uname); |
&logthis("del_dom failed - no homeserver and/or domain"); |
|
} |
} |
} |
} |
} |
} |
|
|
|
# ----------------------------------construct domainconfig user for a domain |
|
sub get_domainconfiguser { |
|
my ($udom) = @_; |
|
return $udom.'-domainconfig'; |
|
} |
|
|
sub retrieve_inst_usertypes { |
sub retrieve_inst_usertypes { |
my ($udom) = @_; |
my ($udom) = @_; |
my (%returnhash,@order); |
my (%returnhash,@order); |
Line 2112 sub process_coursefile {
|
Line 2060 sub process_coursefile {
|
print $fh $env{'form.'.$source}; |
print $fh $env{'form.'.$source}; |
close($fh); |
close($fh); |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase); |
my $mm = new File::MMagic; |
unless ($parse_result eq 'ok') { |
my $mime_type = $mm->checktype_filename($filepath.'/'.$fname); |
&logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result); |
if ($mime_type eq 'text/html') { |
|
my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase); |
|
unless ($parse_result eq 'ok') { |
|
&logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result); |
|
} |
} |
} |
} |
} |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
Line 2356 sub finishuserfileupload {
|
Line 2308 sub finishuserfileupload {
|
} |
} |
} |
} |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles, |
my $mm = new File::MMagic; |
$codebase); |
my $mime_type = $mm->checktype_filename($filepath.'/'.$file); |
unless ($parse_result eq 'ok') { |
if ($mime_type eq 'text/html') { |
&logthis('Failed to parse '.$filepath.$file. |
my $parse_result = &extract_embedded_items($filepath.'/'.$file, |
' for embedded media: '.$parse_result); |
$allfiles,$codebase); |
|
unless ($parse_result eq 'ok') { |
|
&logthis('Failed to parse '.$filepath.$file. |
|
' for embedded media: '.$parse_result); |
|
} |
} |
} |
} |
} |
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { |
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { |
Line 4772 sub usertools_access {
|
Line 4728 sub usertools_access {
|
$toolstatus = $env{'environment.'.$context.'.'.$tool}; |
$toolstatus = $env{'environment.'.$context.'.'.$tool}; |
$inststatus = $env{'environment.inststatus'}; |
$inststatus = $env{'environment.inststatus'}; |
} else { |
} else { |
my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool); |
my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool,'inststatus'); |
$toolstatus = $userenv{$context.'.'.$tool}; |
$toolstatus = $userenv{$context.'.'.$tool}; |
$inststatus = $userenv{'inststatus'}; |
$inststatus = $userenv{'inststatus'}; |
} |
} |
Line 5774 sub auto_instcode_format {
|
Line 5730 sub auto_instcode_format {
|
push(@homeservers,$tryserver); |
push(@homeservers,$tryserver); |
} |
} |
} |
} |
|
} elsif ($caller eq 'requests') { |
|
if ($codedom =~ /^$match_domain$/) { |
|
my $chome = &domain($codedom,'primary'); |
|
unless ($chome eq 'no_host') { |
|
push(@homeservers,$chome); |
|
} |
|
} |
} else { |
} else { |
push(@homeservers,&homeserver($caller,$codedom)); |
push(@homeservers,&homeserver($caller,$codedom)); |
} |
} |