--- loncom/interface/loncommon.pm 2012/05/24 23:41:50 1.1075.2.5 +++ loncom/interface/loncommon.pm 2012/09/01 09:49:08 1.1075.2.14 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.5 2012/05/24 23:41:50 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.14 2012/09/01 09:49:08 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -70,6 +70,8 @@ use Apache::lonclonecourse(); use LONCAPA qw(:DEFAULT :match); use DateTime::TimeZone; use DateTime::Locale::Catalog; +use Authen::Captcha; +use Captcha::reCAPTCHA; # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -885,10 +887,14 @@ sub check_uncheck_jscript { function checkAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { - field[i].checked = true ; + if (!field[i].disabled) { + field[i].checked = true; + } } } else { - field.checked = true + if (!field.disabled) { + field.checked = true; + } } } @@ -4954,6 +4960,9 @@ Inputs: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value +=item * $no_inline_link, if true and in remote mode, don't show the + 'Switch To Inline Menu' link + =item * $args, optional argument valid values are no_auto_mt_title -> prevents &mt()ing the title arg inherit_jsmath -> when creating popup window in a page, @@ -4971,7 +4980,7 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, - $no_nav_bar,$bgcolor,$args)=@_; + $no_nav_bar,$bgcolor,$no_inline_link,$args)=@_; my $public; if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) @@ -5013,6 +5022,8 @@ sub bodytag { } if (!$realm) { $realm=' '; } +# Set messages + my $messages=&domainlogo($domain); my $extra_body_attr = &make_attr_string($forcereg,\%design); @@ -5047,11 +5058,13 @@ sub bodytag { $role = '('.$role.')' if $role; &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']); - if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { - return $bodytag; - } + if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { + return $bodytag; + } + + if ($env{'request.state'} eq 'construct') { $forcereg=1; } - if ($env{'request.state'} eq 'construct') { $forcereg=1; } + unless ($env{'environment.remote'} eq 'on') { # if ($env{'request.state'} eq 'construct') { # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls @@ -5103,6 +5116,55 @@ sub bodytag { } return $bodytag; + } + +# +# Top frame rendering, Remote is up +# + + my $imgsrc = $img; + if ($img =~ /^\/adm/) { + $imgsrc = &lonhttpdurl($img); + } + my $upperleft=''.$function.''; + + # Explicit link to get inline menu + my $menu= ($no_inline_link?'' + :''.&mt('Switch to Inline Menu Mode').''); + + if ($dc_info) { + $dc_info = qq|($dc_info)|; + } + + unless ($env{'form.inhibitmenu'}) { + $bodytag .= qq|
$name $role
+
    +
  1. $menu
    2. +
$realm $dc_info
|; + } + my $funclist; + if ($env{'request.state'} eq 'construct') { + if (!$public){ + if ($env{'request.state'} eq 'construct') { + $funclist = &Apache::lonhtmlcommon::scripttag( + &Apache::lonmenu::utilityfunctions(), 'start'). + &Apache::lonhtmlcommon::scripttag('','end'). + &Apache::lonmenu::innerregister($forcereg, + $args->{'bread_crumbs'}); + } + } + } + return(< +$upperleft + $messages  + +$titleinfo $dc_info $menu + + +$funclist +ENDBODY } sub dc_courseid_toggle { @@ -5134,8 +5196,15 @@ sub make_attr_string { delete($attr_ref->{$key}); } } - $attr_ref->{'onload'} = $on_load; - $attr_ref->{'onunload'}= $on_unload; + if ($env{'environment.remote'} eq 'on') { + $attr_ref->{'onload'} = + &Apache::lonmenu::loadevents(). $on_load; + $attr_ref->{'onunload'}= + &Apache::lonmenu::unloadevents().$on_unload; + } else { + $attr_ref->{'onload'} = $on_load; + $attr_ref->{'onunload'}= $on_unload; + } } my $attr_string; @@ -5165,7 +5234,10 @@ i.e., $env{'internal.head.redirect'} exi sub endbodytag { my ($args) = @_; - my $endbodytag=''; + my $endbodytag; + unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) { + $endbodytag=''; + } $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; if ( exists( $env{'internal.head.redirect'} ) ) { if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) { @@ -6583,6 +6655,7 @@ ul#LC_secondary_menu li:hover ul, ul#LC_ float: none; background-color: $data_table_light; z-index: 2; + margin-left: -1px; } ul#LC_secondary_menu li ul li { @@ -6936,6 +7009,7 @@ ul#LC_toolbar { list-style:none; position:relative; background-color:white; + overflow: auto; } ul#LC_toolbar li { @@ -6945,6 +7019,7 @@ ul#LC_toolbar li { float: left; display:inline; vertical-align:middle; + white-space: nowrap; } @@ -7094,8 +7169,8 @@ sub headtag { if (!$args->{'frameset'}) { $result .= &Apache::lonhtmlcommon::htmlareaheaders(); } - if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) { - $result .= Apache::lonxml::display_title(); + if ($args->{'force_register'}) { + $result .= &Apache::lonmenu::registerurl(1); } if (!$args->{'no_nav_bar'} && !$args->{'only_body'} @@ -7304,6 +7379,8 @@ $args - additional optional args support skip_phases -> hash ref of head -> skip the generation body -> skip all generation + no_inline_link -> if true and in remote mode, don't show the + 'Switch To Inline Menu' link no_auto_mt_title -> prevent &mt()ing the title arg inherit_jsmath -> when creating popup window in a page, should it have jsmath forced on by the @@ -7339,7 +7416,8 @@ sub start_page { $args->{'function'}, $args->{'add_entries'}, $args->{'only_body'}, $args->{'domain'}, $args->{'force_register'}, $args->{'no_nav_bar'}, - $args->{'bgcolor'}, $args); + $args->{'bgcolor'}, $args->{'no_inline_link'}, + $args); } } @@ -7396,7 +7474,9 @@ sub end_page { } else { $result .= &endbodytag($args); } - $result .= "\n"; + unless ($args->{'notbody'}) { + $result .= "\n"; + } if ($args->{'js_ready'}) { $result = &js_ready($result); @@ -9348,7 +9428,7 @@ sub get_env_multiple { sub ask_for_embedded_content { my ($actionurl,$state,$allfiles,$codebase,$args)=@_; my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges, - %currsubfile,%unused); + %currsubfile,%unused,$rem); my $counter = 0; my $numnew = 0; my $numremref = 0; @@ -9361,6 +9441,10 @@ sub ask_for_embedded_content { my $heading = &mt('Upload embedded files'); my $buttontext = &mt('Upload'); + my $navmap; + if ($env{'request.course.id'}) { + $navmap = Apache::lonnavmaps::navmap->new(); + } if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { my $current_path='/'; if ($env{'form.currentpath'}) { @@ -9390,6 +9474,13 @@ sub ask_for_embedded_content { if (ref($args) eq 'HASH') { $url = $args->{'docs_url'}; $toplevel = $url; + if ($args->{'context'} eq 'paste') { + ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/}); + ($path) = + ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/}); + $fileloc = &Apache::lonnet::filelocation('',$toplevel); + $fileloc =~ s{^/}{}; + } } } elsif ($actionurl eq '/adm/dependencies') { if ($env{'request.course.id'} ne '') { @@ -9399,6 +9490,7 @@ sub ask_for_embedded_content { $url = $args->{'docs_url'}; $title = $args->{'docs_title'}; $toplevel = "/$url"; + ($rem) = ($toplevel =~ m{^(.+/)[^/]+$}); ($path) = ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/}); $fileloc = &Apache::lonnet::filelocation('',$toplevel); @@ -9461,7 +9553,9 @@ sub ask_for_embedded_content { my @subdir_list = grep(!/^\./,readdir($dir)); map {$currsubfile{$path}{$_} = 1;} @subdir_list; } - } elsif ($actionurl eq '/adm/dependencies') { + } elsif (($actionurl eq '/adm/dependencies') || + (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') && + ($args->{'context'} eq 'paste'))) { if ($env{'request.course.id'} ne '') { my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$}); if ($dir ne '') { @@ -9497,6 +9591,12 @@ sub ask_for_embedded_content { if (ref($currsubfile{$path}) eq 'HASH') { foreach my $file (keys(%{$currsubfile{$path}})) { unless ($subdependencies{$path}{$file}) { + next if (($rem ne '') && + (($env{"httpref.$rem"."$path/$file"} ne '') || + (ref($navmap) && + (($navmap->getResourceByUrl($rem."$path/$file") ne '') || + (($file =~ /^(.*\.s?html?)\.bak$/i) && + ($navmap->getResourceByUrl($rem."$path/$1"))))))); $unused{$path.'/'.$file} = 1; } } @@ -9519,7 +9619,9 @@ sub ask_for_embedded_content { my @dir_list = grep(!/^\./,readdir($dir)); map {$currfile{$_} = 1;} @dir_list; } - } elsif ($actionurl eq '/adm/dependencies') { + } elsif (($actionurl eq '/adm/dependencies') || + (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') && + ($args->{'context'} eq 'paste'))) { if ($env{'request.course.id'} ne '') { my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$}); if ($dir ne '') { @@ -9553,9 +9655,23 @@ sub ask_for_embedded_content { unless (($file eq $filename) || ($file eq $filename.'.bak') || ($dependencies{$file})) { + if ($actionurl eq '/adm/dependencies') { + next if (($rem ne '') && + (($env{"httpref.$rem".$file} ne '') || + (ref($navmap) && + (($navmap->getResourceByUrl($rem.$file) ne '') || + (($file =~ /^(.*\.s?html?)\.bak$/i) && + ($navmap->getResourceByUrl($rem.$1))))))); + } $unused{$file} = 1; } } + if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') && + ($args->{'context'} eq 'paste')) { + $counter = scalar(keys(%existing)); + $numpathchg = scalar(keys(%pathchanges)); + return ($output,$counter,$numpathchg,\%existing); + } foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) { if ($actionurl eq '/adm/dependencies') { next if ($embed_file =~ m{^\w+://}); @@ -9572,7 +9688,6 @@ sub ask_for_embedded_content { $numremref++; } elsif ($args->{'error_on_invalid_names'} && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) { - $upload_output.=''.&mt('Invalid characters').''; $numinvalid++; } else { @@ -11060,7 +11175,10 @@ function dependencyCheck(form,count,offs document.getElementById('arc_depon_'+count).style.display='block'; form.elements[depitem].options.length = 0; form.elements[depitem].options[0] = new Option('Select','',true,true); - for (var i=1; i'."\n"; @@ -11284,7 +11403,7 @@ sub process_extracted_files { my ($outtext,$errtext)= &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. $docuname.'/'.$folders{$outer}. - '.'.$containers{$outer},1); + '.'.$containers{$outer},1,1); unless ($errtext) { if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { $result .= '
  • '.&mt('File: [_1] added to course',$docstitle).'
    • '."\n"; @@ -11292,87 +11411,93 @@ sub process_extracted_files { } } } - } elsif ($env{'form.archive_'.$i} eq 'dependency') { - my ($title) = ($path =~ m{/([^/]+)$}); - $referrer{$i} = $env{'form.archive_dependent_on_'.$i}; - if ($env{'form.archive_'.$referrer{$i}} eq 'display') { - if (ref($dirorder{$i}) eq 'ARRAY') { - my ($itemidx,$fullpath,$relpath); + } + } else { + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + } + } + for (my $i=1; $i<=$numitems; $i++) { + next unless ($env{'form.archive_'.$i} eq 'dependency'); + my $path = $env{'form.archive_content_'.$i}; + if ($path =~ /^\Q$pathtocheck\E/) { + my ($title) = ($path =~ m{/([^/]+)$}); + $referrer{$i} = $env{'form.archive_dependent_on_'.$i}; + if ($env{'form.archive_'.$referrer{$i}} eq 'display') { + if (ref($dirorder{$i}) eq 'ARRAY') { + my ($itemidx,$fullpath,$relpath); + if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') { + my $container = $dirorder{$referrer{$i}}->[-1]; for (my $j=0; $j<@{$dirorder{$i}}; $j++) { - if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') { - my $container = $dirorder{$referrer{$i}}->[-1]; - for (my $j=0; $j<@{$dirorder{$i}}; $j++) { - if ($dirorder{$i}->[$j] eq $container) { - $itemidx = $j; - } - } + if ($dirorder{$i}->[$j] eq $container) { + $itemidx = $j; } } - if ($itemidx ne '') { - if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { - if ($mapinner{$referrer{$i}}) { - $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; - for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { - if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { - unless (defined($newseqid{$dirorder{$i}->[$j]})) { - $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; - $relpath .= '/'.$titles{$dirorder{$i}->[$j]}; - if (!-e $fullpath) { - mkdir($fullpath,0755); - } - } - } else { - last; + } + if ($itemidx eq '') { + $itemidx = 0; + } + if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) { + if ($mapinner{$referrer{$i}}) { + $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}"; + for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { + if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { + unless (defined($newseqid{$dirorder{$i}->[$j]})) { + $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; + $relpath .= '/'.$titles{$dirorder{$i}->[$j]}; + if (!-e $fullpath) { + mkdir($fullpath,0755); } } + } else { + last; } - } elsif ($newdest{$referrer{$i}}) { - $fullpath = $newdest{$referrer{$i}}; - for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { - if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') { - $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]}; - last; - } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { - unless (defined($newseqid{$dirorder{$i}->[$j]})) { - $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; - $relpath .= '/'.$titles{$dirorder{$i}->[$j]}; - if (!-e $fullpath) { - mkdir($fullpath,0755); - } - } - } else { - last; + } + } + } elsif ($newdest{$referrer{$i}}) { + $fullpath = $newdest{$referrer{$i}}; + for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) { + if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') { + $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]}; + last; + } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) { + unless (defined($newseqid{$dirorder{$i}->[$j]})) { + $fullpath .= '/'.$titles{$dirorder{$i}->[$j]}; + $relpath .= '/'.$titles{$dirorder{$i}->[$j]}; + if (!-e $fullpath) { + mkdir($fullpath,0755); } } + } else { + last; } - if ($fullpath ne '') { - if (-e "$prefix$path") { - system("mv $prefix$path $fullpath/$title"); - } - if (-e "$fullpath/$title") { - my $showpath; - if ($relpath ne '') { - $showpath = "$relpath/$title"; - } else { - $showpath = "/$title"; - } - $result .= '
  • '.&mt('[_1] included as a dependency',$showpath).'
    • '."\n"; - } - unless ($ishome) { - my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; - } + } + } + if ($fullpath ne '') { + if (-e "$prefix$path") { + system("mv $prefix$path $fullpath/$title"); + } + if (-e "$fullpath/$title") { + my $showpath; + if ($relpath ne '') { + $showpath = "$relpath/$title"; + } else { + $showpath = "/$title"; } + $result .= '
  • '.&mt('[_1] included as a dependency',$showpath).'
    • '."\n"; + } + unless ($ishome) { + my $fetch = "$fullpath/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; } } - } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { - $warning .= &mt('[_1] is a dependency of [_2], which was discarded.', - $path,$env{'form.archive_content_'.$referrer{$i}}).'
    '; } + } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { + $warning .= &mt('[_1] is a dependency of [_2], which was discarded.', + $path,$env{'form.archive_content_'.$referrer{$i}}).'
    '; } } else { - $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; + $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
    '; } } if (keys(%todelete)) { @@ -13752,7 +13877,7 @@ sub init_user_environment { %domdef = &Apache::lonnet::get_domain_defaults($domain); } - foreach my $tool ('aboutme','blog','portfolio') { + foreach my $tool ('aboutme','blog','webdav','portfolio') { $userenv{'availabletools.'.$tool} = &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', undef,\%userenv,\%domdef,\%is_adv); @@ -13765,6 +13890,20 @@ sub init_user_environment { \%userenv,\%domdef,\%is_adv); } + $userenv{'canrequest.author'} = + &Apache::lonnet::usertools_access($username,$domain,'requestauthor', + 'reload','requestauthor', + \%userenv,\%domdef,\%is_adv); + my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], + $domain,$username); + my $reqstatus = $reqauthor{'author_status'}; + if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { + if (ref($reqauthor{'author'}) eq 'HASH') { + $userenv{'requestauthorqueued'} = $reqstatus.':'. + $reqauthor{'author'}{'timestamp'}; + } + } + $env{'user.environment'} = "$lonids/$cookie.id"; if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", @@ -13879,6 +14018,224 @@ sub build_release_hashes { return; } +sub update_content_constraints { + my ($cdom,$cnum,$chome,$cid) = @_; + my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); + my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'}); + my %checkresponsetypes; + foreach my $key (keys(%Apache::lonnet::needsrelease)) { + my ($item,$name,$value) = split(/:/,$key); + if ($item eq 'resourcetag') { + if ($name eq 'responsetype') { + $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} + } + } + } + my $navmap = Apache::lonnavmaps::navmap->new(); + if (defined($navmap)) { + my %allresponses; + foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { + my %responses = $res->responseTypes(); + foreach my $key (keys(%responses)) { + next unless(exists($checkresponsetypes{$key})); + $allresponses{$key} += $responses{$key}; + } + } + foreach my $key (keys(%allresponses)) { + my ($major,$minor) = split(/\./,$checkresponsetypes{$key}); + if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { + ($reqdmajor,$reqdminor) = ($major,$minor); + } + } + undef($navmap); + } + unless (($reqdmajor eq '') && ($reqdminor eq '')) { + &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid); + } + return; +} + +sub parse_supplemental_title { + my ($title) = @_; + + my ($foldertitle,$renametitle); + if ($title =~ /&&&/) { + $title = &HTML::Entites::decode($title); + } + if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) { + $renametitle=$4; + my ($time,$uname,$udom) = ($1,$2,$3); + $foldertitle=&Apache::lontexconvert::msgtexconverted($4); + my $name = &plainname($uname,$udom); + $name = &HTML::Entities::encode($name,'"<>&\''); + $renametitle = &HTML::Entities::encode($renametitle,'"<>&\''); + $title=''.&Apache::lonlocal::locallocaltime($time).' '. + $name.':
    '.$foldertitle; + } + if (wantarray) { + return ($title,$foldertitle,$renametitle); + } + return $title; +} + +sub captcha_display { + my ($context,$lonhost) = @_; + my ($output,$error); + my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + if ($captcha eq 'original') { + $output = &create_captcha(); + unless ($output) { + $error = 'captcha'; + } + } elsif ($captcha eq 'recaptcha') { + $output = &create_recaptcha($pubkey); + unless ($output) { + $error = 'recaptcha'; + } + } + return ($output,$error); +} + +sub captcha_response { + my ($context,$lonhost) = @_; + my ($captcha_chk,$captcha_error); + my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost); + if ($captcha eq 'original') { + ($captcha_chk,$captcha_error) = &check_captcha(); + } elsif ($captcha eq 'recaptcha') { + $captcha_chk = &check_recaptcha($privkey); + } else { + $captcha_chk = 1; + } + return ($captcha_chk,$captcha_error); +} + +sub get_captcha_config { + my ($context,$lonhost) = @_; + my ($captcha,$pubkey,$privkey,$hashtocheck); + my $hostname = &Apache::lonnet::hostname($lonhost); + my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); + my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); + if ($context eq 'usercreation') { + my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom); + if (ref($domconfig{$context}) eq 'HASH') { + $hashtocheck = $domconfig{$context}{'cancreate'}; + if (ref($hashtocheck) eq 'HASH') { + if ($hashtocheck->{'captcha'} eq 'recaptcha') { + if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') { + $pubkey = $hashtocheck->{'recaptchakeys'}{'public'}; + $privkey = $hashtocheck->{'recaptchakeys'}{'private'}; + } + if ($privkey && $pubkey) { + $captcha = 'recaptcha'; + } else { + $captcha = 'original'; + } + } elsif ($hashtocheck->{'captcha'} ne 'notused') { + $captcha = 'original'; + } + } + } else { + $captcha = 'captcha'; + } + } elsif ($context eq 'login') { + my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom); + if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') { + $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'}; + $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'}; + if ($privkey && $pubkey) { + $captcha = 'recaptcha'; + } else { + $captcha = 'original'; + } + } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { + $captcha = 'original'; + } + } + return ($captcha,$pubkey,$privkey); +} + +sub create_captcha { + my %captcha_params = &captcha_settings(); + my ($output,$maxtries,$tries) = ('',10,0); + while ($tries < $maxtries) { + $tries ++; + my $captcha = Authen::Captcha->new ( + output_folder => $captcha_params{'output_dir'}, + data_folder => $captcha_params{'db_dir'}, + ); + my $md5sum = $captcha->generate_code($captcha_params{'numchars'}); + + if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { + $output = ''."\n". + &mt('Type in the letters/numbers shown below').' '. + '
    '. + ''; + last; + } + } + return $output; +} + +sub captcha_settings { + my %captcha_params = ( + output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'}, + www_output_dir => "/captchaspool", + db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'}, + numchars => '5', + ); + return %captcha_params; +} + +sub check_captcha { + my ($captcha_chk,$captcha_error); + my $code = $env{'form.code'}; + my $md5sum = $env{'form.crypt'}; + my %captcha_params = &captcha_settings(); + my $captcha = Authen::Captcha->new( + output_folder => $captcha_params{'output_dir'}, + data_folder => $captcha_params{'db_dir'}, + ); + my $captcha_chk = $captcha->check_code($code,$md5sum); + my %captcha_hash = ( + 0 => 'Code not checked (file error)', + -1 => 'Failed: code expired', + -2 => 'Failed: invalid code (not in database)', + -3 => 'Failed: invalid code (code does not match crypt)', + ); + if ($captcha_chk != 1) { + $captcha_error = $captcha_hash{$captcha_chk} + } + return ($captcha_chk,$captcha_error); +} + +sub create_recaptcha { + my ($pubkey) = @_; + my $captcha = Captcha::reCAPTCHA->new; + return $captcha->get_options_setter({theme => 'white'})."\n". + $captcha->get_html($pubkey). + &mt('If either word is hard to read, [_1] will replace them.', + 'reCAPTCHA refresh'). + '

    '; +} + +sub check_recaptcha { + my ($privkey) = @_; + my $captcha_chk; + my $captcha = Captcha::reCAPTCHA->new; + my $captcha_result = + $captcha->check_answer( + $privkey, + $ENV{'REMOTE_ADDR'}, + $env{'form.recaptcha_challenge_field'}, + $env{'form.recaptcha_response_field'}, + ); + if ($captcha_result->{is_valid}) { + $captcha_chk = 1; + } + return $captcha_chk; +} + =pod =back