version 1.1019, 2009/08/18 20:08:25
|
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 5645 sub auto_validate_courseID {
|
Line 5601 sub auto_validate_courseID {
|
} |
} |
|
|
sub auto_validate_instcode { |
sub auto_validate_instcode { |
my ($cnum,$cdom,$instcode,$owner,$inststatuslist,$instseclist) = @_; |
my ($cnum,$cdom,$instcode,$owner) = @_; |
my ($homeserver,$response); |
my ($homeserver,$response); |
if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) { |
if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) { |
$homeserver = &homeserver($cnum,$cdom); |
$homeserver = &homeserver($cnum,$cdom); |
Line 5656 sub auto_validate_instcode {
|
Line 5612 sub auto_validate_instcode {
|
} |
} |
} |
} |
my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. |
my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. |
&escape($instcode).':'.&escape($owner).':'. |
&escape($instcode).':'.&escape($owner),$homeserver)); |
&escape($inststatuslist).':'.&escape($instseclist), |
|
$homeserver)); |
|
return $response; |
return $response; |
} |
} |
|
|
Line 5776 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)); |
} |
} |
Line 5876 sub auto_possible_instcodes {
|
Line 5837 sub auto_possible_instcodes {
|
|
|
sub auto_courserequest_checks { |
sub auto_courserequest_checks { |
my ($dom) = @_; |
my ($dom) = @_; |
my %validations; |
my ($homeserver,%validations); |
|
if ($dom =~ /^$match_domain$/) { |
|
$homeserver = &domain($dom,'primary'); |
|
} |
|
unless ($homeserver eq 'no_host') { |
|
my $response=&reply('autocrsreqchecks:'.$dom,$homeserver); |
|
unless ($response =~ /(con_lost|error|no_such_host|refused)/) { |
|
my @items = split(/&/,$response); |
|
foreach my $item (@items) { |
|
my ($key,$value) = split('=',$item); |
|
$validations{&unescape($key)} = &thaw_unescape($value); |
|
} |
|
} |
|
} |
return %validations; |
return %validations; |
} |
} |
|
|
|
sub auto_courserequest_validation { |
|
my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_; |
|
my ($homeserver,$response); |
|
if ($dom =~ /^$match_domain$/) { |
|
$homeserver = &domain($dom,'primary'); |
|
} |
|
unless ($homeserver eq 'no_host') { |
|
|
|
$response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner). |
|
':'.&escape($crstype).':'.&escape($inststatuslist). |
|
':'.&escape($instcode).':'.&escape($instseclist), |
|
$homeserver)); |
|
} |
|
return $response; |
|
} |
|
|
sub auto_validate_class_sec { |
sub auto_validate_class_sec { |
my ($cdom,$cnum,$owners,$inst_class) = @_; |
my ($cdom,$cnum,$owners,$inst_class) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver = &homeserver($cnum,$cdom); |