--- loncom/interface/loncommon.pm 2019/02/06 16:10:34 1.1075.2.127.2.7 +++ loncom/interface/loncommon.pm 2018/09/09 21:30:40 1.1075.2.130 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.127.2.7 2019/02/06 16:10:34 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.130 2018/09/09 21:30:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -82,8 +82,6 @@ use Crypt::DES; use DynaLoader; # for Crypt::DES version use File::Copy(); use File::Path(); -use String::CRC32(); -use Short::URL(); # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -2264,7 +2262,11 @@ sub select_form { if ($onchange) { $onchange = ' onchange="'.$onchange.'"'; } - my $selectform = "\n"; my @keys; if (exists($hashref->{'select_form_order'})) { @keys=@{$hashref->{'select_form_order'}}; @@ -4722,7 +4724,7 @@ sub blockcheck { ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E})); next if ($no_userblock); - # Retrieve blocking times and identity of locker for course + # Retrieve blocking times and identity of blocker for course # of specified user, unless user has 'evb' privilege. my ($start,$end,$trigger) = @@ -4996,87 +4998,6 @@ sub check_ip_acc { return $allowed; } -sub check_slotip_acc { - my ($acc,$clientip)=@_; - &Apache::lonxml::debug("acc is $acc"); - if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { - return 1; - } - my $allowed; - my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; - - my $name; - my %access = ( - allowfrom => 1, - denyfrom => 0, - ); - my @allows; - my @denies; - foreach my $item (split(',',$acc)) { - $item =~ s/^\s*//; - $item =~ s/\s*$//; - my $pattern; - if ($item =~ /^\!(.+)$/) { - push(@denies,$1); - } else { - push(@allows,$item); - } - } - my $numdenies = scalar(@denies); - my $numallows = scalar(@allows); - my $count = 0; - foreach my $pattern (@denies,@allows) { - $count ++; - my $acctype = 'allowfrom'; - if ($count <= $numdenies) { - $acctype = 'denyfrom'; - } - if ($pattern =~ /\*$/) { - #35.8.* - $pattern=~s/\*//; - if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } - } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { - #35.8.3.[34-56] - my $low=$2; - my $high=$3; - $pattern=$1; - if ($ip =~ /^\Q$pattern\E/) { - my $last=(split(/\./,$ip))[3]; - if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } - } - } elsif ($pattern =~ /^\*/) { - #*.msu.edu - $pattern=~s/\*//; - if (!defined($name)) { - use Socket; - my $netaddr=inet_aton($ip); - ($name)=gethostbyaddr($netaddr,AF_INET); - } - if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } - } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { - #127.0.0.1 - if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } - } else { - #some.name.com - if (!defined($name)) { - use Socket; - my $netaddr=inet_aton($ip); - ($name)=gethostbyaddr($netaddr,AF_INET); - } - if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } - } - if ($allowed =~ /^(0|1)$/) { last; } - } - if ($allowed eq '') { - if ($numdenies && !$numallows) { - $allowed = 1; - } else { - $allowed = 0; - } - } - return $allowed; -} - ############################################### =pod @@ -8473,8 +8394,9 @@ sub end_togglebox { } sub LCprogressbar_script { - my ($id)=@_; - return(< // ENDPROGRESS + } else { + return(< +// + +ENDPROGRESS + } } sub LCprogressbarUpdate_script { return(< .ui-progressbar { position:relative; } +.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; } .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; } @@ -8513,37 +8457,54 @@ my $LCidcnt; my $LCcurrentid; sub LCprogressbar { - my ($r)=(@_); + my ($r,$number_to_do,$preamble)=@_; $LClastpercent=0; $LCidcnt++; $LCcurrentid=$$.'_'.$LCidcnt; - my $starting=&mt('Starting'); - my $content=(< $starting ENDPROGBAR - &r_print($r,$content.&LCprogressbar_script($LCcurrentid)); + } else { + $starting=&mt('Loading...'); + $LClastpercent='false'; + $content=(< +
$starting
+ +ENDPROGBAR + } + &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do)); } sub LCprogressbarUpdate { - my ($r,$val,$text)=@_; - unless ($val) { - if ($LClastpercent) { - $val=$LClastpercent; - } else { - $val=0; - } + my ($r,$val,$text,$number_to_do)=@_; + if ($number_to_do) { + unless ($val) { + if ($LClastpercent) { + $val=$LClastpercent; + } else { + $val=0; + } + } + if ($val<0) { $val=0; } + if ($val>100) { $val=0; } + $LClastpercent=$val; + unless ($text) { $text=$val.'%'; } + } else { + $val = 'false'; } - if ($val<0) { $val=0; } - if ($val>100) { $val=0; } - $LClastpercent=$val; - unless ($text) { $text=$val.'%'; } $text=&js_ready($text); &r_print($r,< // ENDUPDATE @@ -12188,8 +12149,7 @@ sub process_decompression { if (ref($newdirlistref) eq 'ARRAY') { foreach my $dir_line (@{$newdirlistref}) { my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); - unless (($item =~ /^\.+$/) || ($item eq $file) || - ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { + unless (($item =~ /^\.+$/) || ($item eq $file)) { push(@newitems,$item); if ($dirptr&$testdir) { $is_dir{$item} = 1; @@ -12777,7 +12737,7 @@ sub process_extracted_files { $newseqid{$i} = $newidx; unless ($errtext) { $result .= '
  • '.&mt('Folder: [_1] added to course', - &HTML::Entities::encode($docstitle,'<>&"')). + &HTML::Entities::encode($docstitle,'<>&"')).. '
    • '."\n"; } } @@ -12802,7 +12762,7 @@ sub process_extracted_files { $fetch =~ s/^\Q$prefix$dir\E//; $prompttofetch{$fetch} = 1; } - } + } } $LONCAPA::map::resources[$newidx]= $docstitle.':'.$url.':false:normal:res'; @@ -12902,11 +12862,11 @@ sub process_extracted_files { $result .= '
  • '.&mt('[_1] included as a dependency', &HTML::Entities::encode($showpath,'<>&"')). '
    • '."\n"; - } - unless ($ishome) { - my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; + unless ($ishome) { + my $fetch = "$fullpath/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; + } } } } @@ -13193,9 +13153,10 @@ sub upfile_store { $env{'form.upfile'}=~s/\n+$//gs; my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}. - '_enroll_'.$env{'request.course.id'}.'_'. + '_enroll_'.$env{'request.course.id'}.'_'. time.'_'.$$); return if ($datatoken eq ''); + { my $datafile = $r->dir_config('lonDaemons'). '/tmp/'.$datatoken.'.tmp'; @@ -13234,7 +13195,7 @@ sub load_tmp_file { sub valid_datatoken { my ($datatoken) = @_; - if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) { + if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) { return $datatoken; } return; @@ -14128,13 +14089,6 @@ defdom (domain for which to retrieve con origmail (scalar - email address of recipient from loncapa.conf, i.e., predates configuration by DC via domainprefs.pm -$requname username of requester (if mailing type is helpdeskmail) - -$requdom domain of requester (if mailing type is helpdeskmail) - -$reqemail e-mail address of requester (if mailing type is helpdeskmail) - - Returns: comma separated list of addresses to which to send e-mail. =back @@ -14144,7 +14098,7 @@ Returns: comma separated list of address ############################################################ ############################################################ sub build_recipient_list { - my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_; + my ($defmail,$mailing,$defdom,$origmail) = @_; my @recipients; my ($otheremails,$lastresort,$allbcc,$addtext); my %domconfig = @@ -14185,94 +14139,6 @@ sub build_recipient_list { } elsif ($origmail ne '') { $lastresort = $origmail; } - if ($mailing eq 'helpdeskmail') { - if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') && - (keys(%{$domconfig{'contacts'}{'overrides'}}))) { - my ($inststatus,$inststatus_checked); - if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') && - ($env{'user.domain'} ne 'public')) { - $inststatus_checked = 1; - $inststatus = $env{'environment.inststatus'}; - } - unless ($inststatus_checked) { - if (($requname ne '') && ($requdom ne '')) { - if (($requname =~ /^$match_username$/) && - ($requdom =~ /^$match_domain$/) && - (&Apache::lonnet::domain($requdom))) { - my $requhome = &Apache::lonnet::homeserver($requname, - $requdom); - unless ($requhome eq 'no_host') { - my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus'); - $inststatus = $userenv{'inststatus'}; - $inststatus_checked = 1; - } - } - } - } - unless ($inststatus_checked) { - if ($reqemail =~ /^[^\@]+\@[^\@]+$/) { - my %srch = (srchby => 'email', - srchdomain => $defdom, - srchterm => $reqemail, - srchtype => 'exact'); - my %srch_results = &Apache::lonnet::usersearch(\%srch); - foreach my $uname (keys(%srch_results)) { - if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { - $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); - $inststatus_checked = 1; - last; - } - } - unless ($inststatus_checked) { - my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch); - if ($dirsrchres eq 'ok') { - foreach my $uname (keys(%srch_results)) { - if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { - $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); - $inststatus_checked = 1; - last; - } - } - } - } - } - } - if ($inststatus ne '') { - foreach my $status (split(/\:/,$inststatus)) { - if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') { - my @contacts = ('adminemail','supportemail'); - foreach my $item (@contacts) { - if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) { - my $addr = $domconfig{'contacts'}{'overrides'}{$status}; - if (!grep(/^\Q$addr\E$/,@recipients)) { - push(@recipients,$addr); - } - } - } - $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'}; - if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) { - my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'}); - my @ok_bccs; - foreach my $bcc (@bccs) { - $bcc =~ s/^\s+//g; - $bcc =~ s/\s+$//g; - if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { - if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { - push(@ok_bccs,$bcc); - } - } - } - if (@ok_bccs > 0) { - $allbcc = join(', ',@ok_bccs); - } - } - $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'}; - last; - } - } - } - } - } } elsif ($origmail ne '') { $lastresort = $origmail; } @@ -15660,7 +15526,8 @@ sub init_user_environment { my %userenv = &Apache::lonnet::dump('environment',$domain,$username); my ($tmp) = keys(%userenv); - if ($tmp =~ /^(con_lost|error|no_such_host)/i) { + if ($tmp !~ /^(con_lost|error|no_such_host)/i) { + } else { undef(%userenv); } if (($userenv{'interface'}) && (!$form->{'interface'})) { @@ -17057,129 +16924,6 @@ sub des_decrypt { return $plaintext; } -sub make_short_symbs { - my ($cdom,$cnum,$navmap) = @_; - return unless (ref($navmap)); - my ($numnew,@errors); - my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny'); - if (@toshorten) { - my (%maps,%resources,%titles); - &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles, - 'shorturls',$cdom,$cnum); - my %tocreate; - if (keys(%resources)) { - foreach my $item (sort {$a <=> $b} (@toshorten)) { - my $symb = $resources{$item}; - if ($symb) { - $tocreate{$cnum.'&'.$symb} = 1; - } - } - } - if (keys(%tocreate)) { - my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); - my $su = Short::URL->new(no_vowels => 1); - my $init = ''; - my (%newunique,%addcourse,%courseonly,%failed); - # get lock on tiny db - my $now = time; - my $lockhash = { - "lock\0$now" => $env{'user.name'}. - ':'.$env{'user.domain'}, - }; - my $tries = 0; - my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); - my ($code,$error); - while (($gotlock ne 'ok') && ($tries<3)) { - $tries ++; - sleep 1; - $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); - } - if ($gotlock eq 'ok') { - $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique, - \%addcourse,\%courseonly,\%failed); - if (keys(%failed)) { - my $numfailed = scalar(keys(%failed)); - push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed)); - } - if (keys(%newunique)) { - my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom); - if ($putres eq 'ok') { - $numnew = scalar(keys(%newunique)); - my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum); - unless ($newputres eq 'ok') { - push(@errors,&mt('error: could not store course look-up of short URLs')); - } - } else { - push(@errors,&mt('error: could not store unique six character URLs')); - } - } - } - } - return ($numnew,\@errors); -} - -sub shorten_symbs { - my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_; - return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') && - (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') && - (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH')); - my (%possibles,%collisions); - foreach my $key (keys(%{$tocreate})) { - my $num = String::CRC32::crc32($key); - my $tiny = $su->encode($num,$init); - if ($tiny) { - $possibles{$tiny} = $key; - } - } - if (!$init) { - $init = 1; - } else { - $init ++; - } - if (keys(%possibles)) { - my @posstiny = keys(%possibles); - my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); - my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname); - if (keys(%currtiny)) { - foreach my $key (keys(%currtiny)) { - next if ($currtiny{$key} eq ''); - if ($currtiny{$key} eq $possibles{$key}) { - my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key}); - unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { - $courseonly->{$tsymb} = $key; - } - } else { - $collisions{$possibles{$key}} = 1; - } - delete($possibles{$key}); - } - } - foreach my $key (keys(%possibles)) { - $newunique->{$key} = $possibles{$key}; - my ($tcnum,$tsymb) = split(/\&/,$possibles{$key}); - unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { - $addcourse->{$tsymb} = $key; - } - } - } - if (keys(%collisions)) { - if ($init <5) { - if (!$init) { - $init = 1; - } else { - $init ++; - } - $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions, - $newunique,$addcourse,$courseonly,$failed); - } else { - foreach my $key (keys(%collisions)) { - $failed->{$key} = 1; - } - } - } - return $init; -} - 1; __END__;