';
}
}
$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');
}
@@ -8693,7 +8724,7 @@ Incoming parameters:
2. user's domain
3. quota name - portfolio, author, or course
(if no quota name provided, defaults to portfolio).
-4. crstype - official, unofficial or community, if quota name is
+4. crstype - official, unofficial, textbook or community, if quota name is
course
Returns:
@@ -8767,7 +8798,8 @@ sub get_user_quota {
if ($quota eq '' || wantarray) {
if ($quotaname eq 'course') {
my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
- if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) {
+ if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
+ ($crstype eq 'community') || ($crstype eq 'textbook')) {
$defquota = $domdefs{$crstype.'quota'};
}
if ($defquota eq '') {
@@ -8908,13 +8940,14 @@ space to be exceeded.
Same, if upload of a file directly to a course/community via Course Editor
will cause quota for uploaded content for the course to be exceeded.
-Inputs: 6
+Inputs: 7
1. username or coursenum
2. domain
3. context ('author' or 'course')
4. filename of file for which action is being requested
5. filesize (kB) of file
6. action being taken: copy or upload.
+7. quotatype (in course context -- official, unofficial, community or textbook).
Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
otherwise return null.
@@ -8924,9 +8957,9 @@ Returns: 1 scalar: HTML to display conta
=cut
sub excess_filesize_warning {
- my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
+ my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
my $current_disk_usage = 0;
- my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
+ my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
if ($context eq 'author') {
my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
$current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
@@ -8937,10 +8970,10 @@ sub excess_filesize_warning {
}
$disk_quota = int($disk_quota * 1000);
if (($current_disk_usage + $filesize) > $disk_quota) {
- return '
'.
+ return '
'.
&mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
- ''.$filename.'',$filesize).'
'.
- ' '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
+ ''.$filename.'',$filesize).'
'.
+ '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
$disk_quota,$current_disk_usage).
'
';
}
@@ -10887,11 +10920,11 @@ sub check_for_upload {
if ($currsize < $filesize) {
my $extra = $filesize - $currsize;
if (($current_disk_usage + $extra) > $disk_quota) {
- my $msg = ''.
+ my $msg = '
'.
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.',
- ''.$fname.'',$filesize,$currsize).'
'.
- ' '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
- $disk_quota,$current_disk_usage);
+ ''.$fname.'',$filesize,$currsize).''.
+ '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
+ $disk_quota,$current_disk_usage).'
';
return ('will_exceed_quota',$msg);
}
}
@@ -10900,21 +10933,21 @@ sub check_for_upload {
}
}
if (($current_disk_usage + $filesize) > $disk_quota){
- my $msg = ''.
- &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.'',$filesize).''.
+ my $msg = '
'.
+ &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$fname.'',$filesize).'
'.
' '.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
return ('will_exceed_quota',$msg);
} elsif ($found_file) {
if ($locked_file) {
- my $msg = '';
+ my $msg = '
';
$msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].',''.$fname.'',''.$port_path.$env{'form.currentpath'}.'');
- $msg .= '
';
+ $msg .= '';
$msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.',''.$fname.'');
return ('file_locked',$msg);
} else {
- my $msg = '';
+ my $msg = '
';
$msg .= &mt(' A file by that name: [_1] was found in [_2].',''.$fname.'',$port_path.$env{'form.currentpath'});
- $msg .= '
';
+ $msg .= '';
return ('existingfile',$msg);
}
}
@@ -11005,16 +11038,43 @@ sub decompress_form {
}
}
if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
- my @camtasia = ("$topdir/","$topdir/index.html",
+ my @camtasia6 = ("$topdir/","$topdir/index.html",
"$topdir/media/",
"$topdir/media/$topdir.mp4",
"$topdir/media/FirstFrame.png",
"$topdir/media/player.swf",
"$topdir/media/swfobject.js",
"$topdir/media/expressInstall.swf");
- my @diffs = &compare_arrays(\@paths,\@camtasia);
+ my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
+ "$topdir/$topdir.mp4",
+ "$topdir/$topdir\_config.xml",
+ "$topdir/$topdir\_controller.swf",
+ "$topdir/$topdir\_embed.css",
+ "$topdir/$topdir\_First_Frame.png",
+ "$topdir/$topdir\_player.html",
+ "$topdir/$topdir\_Thumbnails.png",
+ "$topdir/playerProductInstall.swf",
+ "$topdir/scripts/",
+ "$topdir/scripts/config_xml.js",
+ "$topdir/scripts/handlebars.js",
+ "$topdir/scripts/jquery-1.7.1.min.js",
+ "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
+ "$topdir/scripts/modernizr.js",
+ "$topdir/scripts/player-min.js",
+ "$topdir/scripts/swfobject.js",
+ "$topdir/skins/",
+ "$topdir/skins/configuration_express.xml",
+ "$topdir/skins/express_show/",
+ "$topdir/skins/express_show/player-min.css",
+ "$topdir/skins/express_show/spritesheet.png");
+ my @diffs = &compare_arrays(\@paths,\@camtasia6);
if (@diffs == 0) {
- $is_camtasia = 1;
+ $is_camtasia = 6;
+ } else {
+ @diffs = &compare_arrays(\@paths,\@camtasia8);
+ if (@diffs == 0) {
+ $is_camtasia = 8;
+ }
}
}
my $output;
@@ -11026,7 +11086,7 @@ sub decompress_form {
function camtasiaToggle() {
for (var i=0; i'.
''.$lt{'proa'}.' '.
@@ -11212,7 +11272,7 @@ sub decompress_uploaded_file {
sub process_decompression {
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
my ($dir,$error,$warning,$output);
- if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
+ if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
$error = &mt('Filename not a supported archive file type.').
' '.&mt('Filename should end with one of: [_1].',
'.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
@@ -11322,6 +11382,7 @@ sub process_decompression {
\%titles,\%children);
}
if ($env{'form.autoextract_camtasia'}) {
+ my $version = $env{'form.autoextract_camtasia'};
my %displayed;
my $total = 1;
$env{'form.archive_directory'} = [];
@@ -11340,12 +11401,15 @@ sub process_decompression {
$env{'form.archive_'.$i} = 'display';
$env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
$displayed{'folder'} = $i;
- } elsif ($item eq "$contents[0]/index.html") {
+ } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
+ (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
$env{'form.archive_'.$i} = 'display';
$env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
$displayed{'web'} = $i;
} else {
- if ($item eq "$contents[0]/media") {
+ if ((($item eq "$contents[0]/media") && ($version == 6)) ||
+ ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
+ ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
push(@{$env{'form.archive_directory'}},$i);
}
$env{'form.archive_'.$i} = 'dependency';
@@ -13851,7 +13915,7 @@ sub check_clone {
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
my $outcome;
my $linefeed = ' '."\n";
if ($context eq 'auto') {
@@ -13948,8 +14012,12 @@ sub construct_course {
'plc.users.denied',
'hidefromcat',
'checkforpriv',
- 'categories'],
+ 'categories',
+ 'internal.uniquecode'],
$$crsudom,$$crsunum);
+ if ($args->{'textbook'}) {
+ $cenv{'internal.textbook'} = $args->{'textbook'};
+ }
}
#
@@ -14133,6 +14201,25 @@ sub construct_course {
}
}
+#
+# 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;
+ }
+ }
+ }
+
if ($args->{'disresdis'}) {
$cenv{'pch.roles.denied'}='st';
}
@@ -14201,6 +14288,60 @@ sub construct_course {
return (1,$outcome);
}
+sub make_unique_code {
+ my ($cdom,$cnum) = @_;
+ # get lock on uniquecodes db
+ my $lockhash = {
+ $cnum."\0".'uniquecodes' => $env{'user.name'}.
+ ':'.$env{'user.domain'},
+ };
+ my $tries = 0;
+ my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+ my ($code,$error);
+
+ while (($gotlock ne 'ok') && ($tries<3)) {
+ $tries ++;
+ sleep 1;
+ $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
+ }
+ if ($gotlock eq 'ok') {
+ my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
+ my $gotcode;
+ my $attempts = 0;
+ while ((!$gotcode) && ($attempts < 100)) {
+ $code = &generate_code();
+ if (!exists($currcodes{$code})) {
+ $gotcode = 1;
+ unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
+ $error = 'nostore';
+ }
+ }
+ $attempts ++;
+ }
+ my @del_lock = ($cnum."\0".'uniquecodes');
+ my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
+ } else {
+ $error = 'nolock';
+ }
+ return ($code,$error);
+}
+
+sub generate_code {
+ my $code;
+ my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
+ for (my $i=0; $i<6; $i++) {
+ my $lettnum = int (rand 2);
+ my $item = '';
+ if ($lettnum) {
+ $item = $letts[int( rand(18) )];
+ } else {
+ $item = 1+int( rand(8) );
+ }
+ $code .= $item;
+ }
+ return $code;
+}
+
############################################################
############################################################
@@ -14228,11 +14369,12 @@ sub group_term {
}
sub course_types {
- my @types = ('official','unofficial','community');
+ my @types = ('official','unofficial','community','textbook');
my %typename = (
official => 'Official course',
unofficial => 'Unofficial course',
community => 'Community',
+ textbook => 'Textbook course',
);
return (\@types,\%typename);
}
@@ -14435,7 +14577,7 @@ sub init_user_environment {
undef,\%userenv,\%domdef,\%is_adv);
}
- foreach my $crstype ('official','unofficial','community') {
+ foreach my $crstype ('official','unofficial','community','textbook') {
$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,
'reload','requestcourses',
@@ -14755,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 {
@@ -14839,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;
}
}
@@ -14910,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;
@@ -14932,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
';
+ ''.
+ '