--- loncom/interface/loncommon.pm 2013/12/25 09:52:42 1.1166
+++ 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.1166 2013/12/25 09:52:42 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);
@@ -1380,16 +1382,21 @@ sub top_nav_help {
$text = &mt($text);
my $stay_on_page = 1;
- my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
- : "javascript:helpMenu('open')";
- my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
-
+ my ($link,$banner_link);
+ unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
+ $link = ($stay_on_page) ? "javascript:helpMenu('display')"
+ : "javascript:helpMenu('open')";
+ $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
+ }
my $title = &mt('Get help');
-
- return <<"END";
+ if ($link) {
+ return <<"END";
$banner_link
$text
END
+ } else {
+ return ' '.$text.' ';
+ }
}
sub help_menu_js {
@@ -1406,7 +1413,7 @@ sub help_menu_js {
'js_ready' => 1,
'use_absolute' => $httphost,
'add_entries' => {
- 'border' => '0',
+ 'border' => '0',
'rows' => "110,*",},});
my $end_page =
&Apache::loncommon::end_page({'frameset' => 1,
@@ -1436,9 +1443,10 @@ function helpMenu(target) {
return;
}
function writeHelp(caller) {
- caller.document.writeln('$start_page\\n\\n\\n$end_page')
- caller.document.close()
- caller.focus()
+ caller.document.writeln('$start_page\\n\\n');
+ caller.document.writeln('\\n$end_page');
+ caller.document.close();
+ caller.focus();
}
// END LON-CAPA Internal -->
// ]]>
@@ -3884,7 +3892,7 @@ sub get_previous_attempt {
if ($key =~/$regexp$/ && (defined &$gradesub)) {
$value = &$gradesub($value);
}
- $prevattempts.='
'.$value.' | ';
+ $prevattempts.=''. $value.' | ';
} else {
$prevattempts.=' | ';
}
@@ -3900,7 +3908,7 @@ sub get_previous_attempt {
if ($key =~/$regexp$/ && (defined &$gradesub)) {
$value = &$gradesub($value);
}
- $prevattempts.=''.$value.' | ';
+ $prevattempts.=''.$value.' | ';
}
}
$prevattempts.= &end_data_table_row().&end_data_table();
@@ -3921,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]};
@@ -3948,7 +3958,7 @@ sub format_previous_attempt_value {
}
}
} else {
- $value = &unescape($value);
+ $value = &HTML::Entities::encode(&unescape($value), '"<>&');
}
return $value;
}
@@ -5141,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);
@@ -5222,6 +5235,10 @@ sub bodytag {
}
$bodytag .= qq|$realm $dc_info
|;
+ #if directed to not display the secondary menu, don't.
+ if ($args->{'no_secondary_menu'}) {
+ return $bodytag;
+ }
#don't show menus for public users
if (!$public){
$bodytag .= Apache::lonmenu::secondary_menu($httphost);
@@ -7330,7 +7347,11 @@ ADDMETA
}
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
$result .= ' LON-CAPA '.$title.''
- .''
+ .'{'frameset'}) {
+ $result .= ' /';
+ }
+ $result .= '>'
.$inhibitprint
.$head_extra;
if ($env{'browser.mobile'}) {
@@ -7356,8 +7377,12 @@ sub font_settings {
my $headerstring='';
if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
- $headerstring.=
- ''."\n";
+ $headerstring.=
+ '{'frameset'}) {
+ $headerstring.= ' /';
+ }
+ $headerstring .= '>'."\n";
}
return $headerstring;
}
@@ -7449,6 +7474,7 @@ Inputs: none
=cut
sub xml_begin {
+ my ($is_frameset) = @_;
my $output='';
if ($env{'browser.mathml'}) {
@@ -7460,9 +7486,12 @@ sub xml_begin {
.''
.'';
+ } elsif ($is_frameset) {
+ $output=''."\n".
+ ''."\n";
} else {
- $output=''."\n"
- .''."\n";
+ $output=''."\n".
+ ''."\n";
}
return $output;
}
@@ -7529,7 +7558,7 @@ sub start_page {
my ($result,@advtools);
if (! exists($args->{'skip_phases'}{'head'}) ) {
- $result .= &xml_begin() . &headtag($title, $head_extra, $args);
+ $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
}
if (! exists($args->{'skip_phases'}{'body'}) ) {
@@ -7630,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');
}
@@ -13984,6 +14015,9 @@ sub construct_course {
'categories',
'internal.uniquecode'],
$$crsudom,$$crsunum);
+ if ($args->{'textbook'}) {
+ $cenv{'internal.textbook'} = $args->{'textbook'};
+ }
}
#
@@ -14168,12 +14202,18 @@ sub construct_course {
}
#
-# course should have uniquecode (available to course requester).
+# generate and store uniquecode (available to course requester), if course should have one.
#
if ($args->{'uniquecode'}) {
my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
if ($code) {
$cenv{'internal.uniquecode'} = $code;
+ my %crsinfo =
+ &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
+ if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
+ $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
+ my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
+ }
if (ref($coderef)) {
$$coderef = $code;
}
@@ -14857,15 +14897,15 @@ sub captcha_display {
if ($captcha eq 'original') {
$output = &create_captcha();
unless ($output) {
- $error = 'captcha';
+ $error = 'captcha';
}
} elsif ($captcha eq 'recaptcha') {
$output = &create_recaptcha($pubkey);
unless ($output) {
- $error = 'recaptcha';
+ $error = 'recaptcha';
}
}
- return ($output,$error);
+ return ($output,$error,$captcha);
}
sub captcha_response {
@@ -14941,8 +14981,9 @@ sub create_captcha {
if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
$output = ''."\n".
&mt('Type in the letters/numbers shown below').' '.
- '
'.
- '';
+ ''.
+ '
'.
+ '';
last;
}
}
@@ -15012,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;
@@ -15034,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