--- loncom/interface/loncommon.pm 2006/09/19 19:03:22 1.456
+++ loncom/interface/loncommon.pm 2007/08/30 23:02:03 1.564.2.4
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.456 2006/09/19 19:03:22 albertel Exp $
+# $Id: loncommon.pm,v 1.564.2.4 2007/08/30 23:02:03 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,16 +59,21 @@ use Apache::lonnet;
use GDBM_File;
use POSIX qw(strftime mktime);
use Apache::lonmenu();
+use Apache::lonenc();
use Apache::lonlocal;
use HTML::Entities;
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
use Apache::lontexconvert();
use Apache::lonclonecourse();
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
+
+# ---------------------------------------------- Designs
+use vars qw(%defaultdesign);
my $readit;
+
##
## Global Variables
##
@@ -81,10 +86,6 @@ my %scprtag;
my %fe; my %fd; my %fm;
my %category_extensions;
-# ---------------------------------------------- Designs
-
-my %designhash;
-
# ---------------------------------------------- Thesaurus variables
#
# %Keywords:
@@ -150,30 +151,18 @@ BEGIN {
}
}
-# -------------------------------------------------------------- domain designs
-
- my $filename;
+# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
- opendir(DIR,$designdir);
- while ($filename=readdir(DIR)) {
- if ($filename!~/\.tab$/) { next; }
- my ($domain)=($filename=~/^(\w+)\./);
- {
- my $designfile = $designdir.'/'.$filename;
- if ( open (my $fh,"<$designfile") ) {
- while (my $line = <$fh>) {
- next if ($line =~ /^\#/);
- chomp($line);
- my ($key,$val)=(split(/\=/,$line));
- if ($val) { $designhash{$domain.'.'.$key}=$val; }
- }
- close($fh);
- }
- }
-
+ my $designfile = $designdir.'/default.tab';
+ if ( open (my $fh,"<$designfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\=/,$line));
+ if ($val) { $defaultdesign{$key}=$val; }
+ }
+ close($fh);
}
- closedir(DIR);
-
# ------------------------------------------------------------- file categories
{
@@ -345,10 +334,12 @@ sub studentbrowser_javascript {
return (<<'ENDSTDBRW');
+
+ function getFormIdByName(formname) {
+ for (var i=0;i".&mt('Select [_1]',$selecttype)."";
+ return "".&mt('Select Course')."";
}
sub check_uncheck_jscript {
@@ -461,7 +526,8 @@ function uncheckAll(field) {
if (field.length > 0) {
for (i = 0; i < field.length; i++) {
field[i].checked = false ;
- } } else {
+ }
+ } else {
field.checked = false ;
}
}
@@ -645,8 +711,7 @@ sub help_open_topic {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'browser.interface'} eq 'textual' ||
- $env{'environment.remote'} eq 'off' ) {
+ if ($env{'browser.interface'} eq 'textual') {
$stayOnPage=1;
}
$width = 350 if (not defined $width);
@@ -738,12 +803,17 @@ ENDOUTPUT
# now just updates the help link and generates a blue icon
sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
- = @_;
-
+ = @_;
$stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'browser.interface'} eq 'textual' ||
- $env{'environment.remote'} eq 'off' ) {
- $stayOnPage=1;
+ # formerly only used pop-up help (stayOnPage = 0)
+ # if environment.remote is on (using remote control UI)
+ # if ($env{'browser.interface'} eq 'textual' ||
+ # $env{'environment.remote'} eq 'off' ) {
+ # $stayOnPage=1;
+ #}
+ # Now making pop-up help the default even with remote control
+ if ($env{'browser.interface'} eq 'textual') {
+ $stayOnPage=1;
}
my $output;
if ($component_help) {
@@ -1015,7 +1085,7 @@ sub changable_area {
=pod
=back
-
+
=head1 Excel and CSV file utility routines
=over 4
@@ -1149,7 +1219,7 @@ sub create_workbook {
=item * create_text_file
-Create a file to write to and eventually make available to the usre.
+Create a file to write to and eventually make available to the user.
If file creation fails, outputs an error message on the request object and
return undefs.
@@ -1190,41 +1260,19 @@ sub create_text_file {
## Home server
';
+ my $krb_msg = &mt('As you did not include the default Kerberos domain to be used for authentication in this class, the institutional data used by the automated enrollment process must include the Kerberos domain for each new student');
+ if ($context eq 'auto') {
+ $outcome .= $krb_msg;
+ } else {
+ $outcome .= ''.$krb_msg.'';
+ }
+ $outcome .= $linefeed;
}
}
if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
@@ -5831,9 +7186,11 @@ sub construct_course {
# if specified, key authority is not course, but user
# only active if keyaccess is yes
if ($args->{'keyauth'}) {
- $args->{'keyauth'}=~s/[^\w\@]//g;
- if ($args->{'keyauth'}) {
- $cenv{'keyauth'}=$args->{'keyauth'};
+ my ($user,$domain) = split(':',$args->{'keyauth'});
+ $user = &LONCAPA::clean_username($user);
+ $domain = &LONCAPA::clean_username($domain);
+ if ($user ne '' && $domain ne '') {
+ $cenv{'keyauth'}=$user.':'.$domain;
}
}
@@ -5861,8 +7218,8 @@ sub construct_course {
# By default, use standard grading
if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
- $outcome .= (' '.&mt('Setting environment').': '.
- &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).' ');
+ $outcome .= $linefeed.&mt('Setting environment').': '.
+ &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
#
# Open all assignments
#
@@ -5872,7 +7229,7 @@ sub construct_course {
$storeunder.'.type' => 'date_start');
$outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
- ('resourcedata',\%storecontent,$$crsudom,$$crsunum).' ';
+ ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}
#
# Set first page
@@ -5899,9 +7256,10 @@ sub construct_course {
(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
if ($errtext) { $fatal=2; }
- $outcome .= ($fatal?$errtext:'write ok').' ';
+ $outcome .= ($fatal?$errtext:'write ok').$linefeed;
}
- return $outcome;
+
+ return (1,$outcome);
}
############################################################
@@ -5930,7 +7288,7 @@ sub group_term {
sub icon {
my ($file)=@_;
- my $curfext = (split(/\./,$file))[-1];
+ my $curfext = lc((split(/\./,$file))[-1]);
my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
my $embstyle = &Apache::loncommon::fileembstyle($curfext);
if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
@@ -5944,10 +7302,27 @@ sub icon {
return &lonhttpdurl($iconname);
}
-sub lonhttpdurl {
- my ($url)=@_;
+sub lonhttpd_port {
my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
+ # IE doesn't like a secure page getting images from a non-secure
+ # port (when logging we haven't parsed the browser type so default
+ # back to secure
+ if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
+ && $ENV{'SERVER_PORT'} == 443) {
+ return 443;
+ }
+ return $lonhttpd_port;
+
+}
+
+sub lonhttpdurl {
+ my ($url)=@_;
+
+ my $lonhttpd_port = &lonhttpd_port();
+ if ($lonhttpd_port == 443) {
+ return 'https://'.$ENV{'SERVER_NAME'}.$url;
+ }
return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
}
@@ -5983,6 +7358,171 @@ sub escape_url {
my $lastitem = &escape(pop(@urlslices));
return join('/',@urlslices).'/'.$lastitem;
}
+
+# -------------------------------------------------------- Initliaze user login
+sub init_user_environment {
+ my ($r, $username, $domain, $authhost, $form, $args) = @_;
+ my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
+
+ my $public=($username eq 'public' && $domain eq 'public');
+
+# See if old ID present, if so, remove
+
+ my ($filename,$cookie,$userroles);
+ my $now=time;
+
+ if ($public) {
+ my $max_public=100;
+ my $oldest;
+ my $oldest_time=0;
+ for(my $next=1;$next<=$max_public;$next++) {
+ if (-e $lonids."/publicuser_$next.id") {
+ my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
+ if ($mtime<$oldest_time || !$oldest_time) {
+ $oldest_time=$mtime;
+ $oldest=$next;
+ }
+ } else {
+ $cookie="publicuser_$next";
+ last;
+ }
+ }
+ if (!$cookie) { $cookie="publicuser_$oldest"; }
+ } else {
+ # if this isn't a robot, kill any existing non-robot sessions
+ if (!$args->{'robot'}) {
+ opendir(DIR,$lonids);
+ while ($filename=readdir(DIR)) {
+ if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
+ unlink($lonids.'/'.$filename);
+ }
+ }
+ closedir(DIR);
+ }
+# Give them a new cookie
+ my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
+ : $now);
+ $cookie="$username\_$id\_$domain\_$authhost";
+
+# Initialize roles
+
+ $userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
+ }
+# ------------------------------------ Check browser type and MathML capability
+
+ my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+ $clientunicode,$clientos) = &decode_user_agent($r);
+
+# -------------------------------------- Any accessibility options to remember?
+ if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if ($form->{$option} eq 'true') {
+ &Apache::lonnet::put('environment',{$option => 'on'},
+ $domain,$username);
+ } else {
+ &Apache::lonnet::del('environment',[$option],
+ $domain,$username);
+ }
+ }
+ }
+# ------------------------------------------------------------- Get environment
+
+ my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
+ my ($tmp) = keys(%userenv);
+ if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+ # default remote control to off
+ if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
+ } else {
+ undef(%userenv);
+ }
+ if (($userenv{'interface'}) && (!$form->{'interface'})) {
+ $form->{'interface'}=$userenv{'interface'};
+ }
+ $env{'environment.remote'}=$userenv{'remote'};
+ if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
+
+# --------------- Do not trust query string to be put directly into environment
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite',
+ 'interface','localpath','localres') {
+ $form->{$option}=~s/[\n\r\=]//gs;
+ }
+# --------------------------------------------------------- Write first profile
+
+ {
+ my %initial_env =
+ ("user.name" => $username,
+ "user.domain" => $domain,
+ "user.home" => $authhost,
+ "browser.type" => $clientbrowser,
+ "browser.version" => $clientversion,
+ "browser.mathml" => $clientmathml,
+ "browser.unicode" => $clientunicode,
+ "browser.os" => $clientos,
+ "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
+ "request.course.fn" => '',
+ "request.course.uri" => '',
+ "request.course.sec" => '',
+ "request.role" => 'cm',
+ "request.role.adv" => $env{'user.adv'},
+ "request.host" => $ENV{'REMOTE_ADDR'},);
+
+ if ($form->{'localpath'}) {
+ $initial_env{"browser.localpath"} = $form->{'localpath'};
+ $initial_env{"browser.localres"} = $form->{'localres'};
+ }
+
+ if ($public) {
+ $initial_env{"environment.remote"} = "off";
+ }
+ if ($form->{'interface'}) {
+ $form->{'interface'}=~s/\W//gs;
+ $initial_env{"browser.interface"} = $form->{'interface'};
+ $env{'browser.interface'}=$form->{'interface'};
+ foreach my $option ('imagesuppress','appletsuppress',
+ 'embedsuppress','fontenhance','blackwhite') {
+ if (($form->{$option} eq 'true') ||
+ ($userenv{$option} eq 'on')) {
+ $initial_env{"browser.$option"} = "on";
+ }
+ }
+ }
+
+ $env{'user.environment'} = "$lonids/$cookie.id";
+
+ if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
+ &GDBM_WRCREAT(),0640)) {
+ &_add_to_env(\%disk_env,\%initial_env);
+ &_add_to_env(\%disk_env,\%userenv,'environment.');
+ &_add_to_env(\%disk_env,$userroles);
+ if (ref($args->{'extra_env'})) {
+ &_add_to_env(\%disk_env,$args->{'extra_env'});
+ }
+ untie(%disk_env);
+ } else {
+ &Apache::lonnet::logthis("WARNING: ".
+ 'Could not create environment storage in lonauth: '.$!.'');
+ return 'error: '.$!;
+ }
+ }
+ $env{'request.role'}='cm';
+ $env{'request.role.adv'}=$env{'user.adv'};
+ $env{'browser.type'}=$clientbrowser;
+
+ return $cookie;
+
+}
+
+sub _add_to_env {
+ my ($idf,$env_data,$prefix) = @_;
+ while (my ($key,$value) = each(%$env_data)) {
+ $idf->{$prefix.$key} = $value;
+ $env{$prefix.$key} = $value;
+ }
+}
+
+
=pod
=back