--- loncom/interface/loncommon.pm 2014/01/27 02:21:30 1.1172 +++ loncom/interface/loncommon.pm 2014/02/23 20:52:58 1.1178 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1172 2014/01/27 02:21:30 raeburn Exp $ +# $Id: loncommon.pm,v 1.1178 2014/02/23 20:52:58 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -75,6 +75,8 @@ use DateTime::Locale::Catalog; use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; +use Crypt::DES; +use DynaLoader; # for Crypt::DES version # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -3846,7 +3848,7 @@ sub get_previous_attempt { if (($data eq 'award') || ($data eq 'awarddetail')) { my $value = &format_previous_attempt_value($key, $returnhash{$version.':'.$key}); - $prevattempts.=''.&HTML::Entities::encode($value, '"<>&').' '; + $prevattempts.=''.$value.' '; } else { $prevattempts.=' '; } @@ -3854,7 +3856,7 @@ sub get_previous_attempt { if ($key =~ /\./) { my $value = &format_previous_attempt_value($key, $returnhash{$version.':'.$key}); - $prevattempts.=''.&HTML::Entities::encode($value, '"<>&').' '; + $prevattempts.=''.$value.' '; } else { $prevattempts.=' '; } @@ -3865,7 +3867,7 @@ sub get_previous_attempt { next if ($key =~ /\.foilorder$/); my $value = &format_previous_attempt_value($key, $returnhash{$version.':'.$key}); - $prevattempts.=''.&HTML::Entities::encode($value, '"<>&').' '; + $prevattempts.=''.$value.' '; } } $prevattempts.=&end_data_table_row(); @@ -3890,7 +3892,7 @@ sub get_previous_attempt { if ($key =~/$regexp$/ && (defined &$gradesub)) { $value = &$gradesub($value); } - $prevattempts.=''. &HTML::Entities::encode($value, '"<>&').' '; + $prevattempts.=''. $value.' '; } else { $prevattempts.=' '; } @@ -3899,14 +3901,14 @@ sub get_previous_attempt { if ($key =~/$regexp$/ && (defined &$gradesub)) { $value = &$gradesub($value); } - $prevattempts.=''.&HTML::Entities::encode($value, '"<>&').' '; + $prevattempts.=''.$value.' '; } } else { my $value = &format_previous_attempt_value($key,$lasthash{$key}); if ($key =~/$regexp$/ && (defined &$gradesub)) { $value = &$gradesub($value); } - $prevattempts.=''.&HTML::Entities::encode($value, '"<>&').' '; + $prevattempts.=''.$value.' '; } } $prevattempts.= &end_data_table_row().&end_data_table(); @@ -3927,11 +3929,13 @@ sub get_previous_attempt { sub format_previous_attempt_value { my ($key,$value) = @_; if (($key =~ /timestamp/) || ($key=~/duedate/)) { - $value = &Apache::lonlocal::locallocaltime($value); + $value = &Apache::lonlocal::locallocaltime($value); } elsif (ref($value) eq 'ARRAY') { - $value = '('.join(', ', @{ $value }).')'; + $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&'); } elsif ($key =~ /answerstring$/) { my %answers = &Apache::lonnet::str2hash($value); + my @answer = %answers; + %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer; my @anskeys = sort(keys(%answers)); if (@anskeys == 1) { my $answer = $answers{$anskeys[0]}; @@ -3954,7 +3958,7 @@ sub format_previous_attempt_value { } } } else { - $value = &unescape($value); + $value = &HTML::Entities::encode(&unescape($value), '"<>&'); } return $value; } @@ -5147,7 +5151,10 @@ sub bodytag { @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; # role and realm - my ($role,$realm) = split(/\./,$env{'request.role'},2); + my ($role,$realm) = split(m{\./},$env{'request.role'},2); + if ($realm) { + $realm = '/'.$realm; + } if ($role eq 'ca') { my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); $realm = &plainname($rname,$rdom); @@ -7652,9 +7659,11 @@ function set_wishlistlink(title, path) { title = document.title; title = title.replace(/^LON-CAPA /,''); } + title = encodeURIComponent(title); if (!path) { path = location.pathname; } + path = encodeURIComponent(path); Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path, 'wishlistNewLink','width=560,height=350,scrollbars=0'); } @@ -14896,7 +14905,7 @@ sub captcha_display { $error = 'recaptcha'; } } - return ($output,$error); + return ($output,$error,$captcha); } sub captcha_response { @@ -14972,8 +14981,9 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". &mt('Type in the letters/numbers shown below').' '. - '
'. - 'captcha'; + ''. + '
'. + 'captcha'; last; } } @@ -15043,6 +15053,19 @@ sub check_recaptcha { return $captcha_chk; } +sub emailusername_info { + my @fields = ('firstname','lastname','institution','web','location','officialemail'); + my %titles = &Apache::lonlocal::texthash ( + lastname => 'Last Name', + firstname => 'First Name', + institution => 'School/college/university', + location => "School's city, state/province, country", + web => "School's web address", + officialemail => 'E-mail address at institution (if different)', + ); + return (\@fields,\%titles); +} + sub cleanup_html { my ($incoming) = @_; my $outgoing; @@ -15065,6 +15088,48 @@ sub cleanup_html { return $outgoing; } +# Use: +# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver); +# +################################################## +# password associated functions # +################################################## +sub des_keys { + # Make a new key for DES encryption. + # Each key has two parts which are returned separately. + # Please note: Each key must be passed through the &hex function + # before it is output to the web browser. The hex versions cannot + # be used to decrypt. + my @hexstr=('0','1','2','3','4','5','6','7', + '8','9','a','b','c','d','e','f'); + my $lkey=''; + for (0..7) { + $lkey.=$hexstr[rand(15)]; + } + my $ukey=''; + for (0..7) { + $ukey.=$hexstr[rand(15)]; + } + return ($lkey,$ukey); +} + +sub des_decrypt { + my ($key,$cyphertext) = @_; + my $keybin=pack("H16",$key); + my $cypher; + if ($Crypt::DES::VERSION>=2.03) { + $cypher=new Crypt::DES $keybin; + } else { + $cypher=new DES $keybin; + } + my $plaintext= + $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16)))); + $plaintext.= + $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16)))); + $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) ); + return $plaintext; +} + =pod =back 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.