--- loncom/lonnet/perl/lonnet.pm 2008/07/17 21:22:51 1.963 +++ loncom/lonnet/perl/lonnet.pm 2008/09/12 21:25:54 1.968 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.963 2008/07/17 21:22:51 raeburn Exp $ +# $Id: lonnet.pm,v 1.968 2008/09/12 21:25:54 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -34,7 +34,7 @@ use LWP::UserAgent(); use HTTP::Date; # use Date::Parse; use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir - $_64bit %env); + $_64bit %env %protocol); my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, %userrolehash, $processmarker, $dumpcount, %coursedombuf, @@ -643,7 +643,11 @@ sub spareserver { } if (!$want_server_name) { - $spare_server="http://".&hostname($spare_server); + my $protocol = 'http'; + if ($protocol{$spare_server} eq 'https') { + $protocol = $protocol{$spare_server}; + } + $spare_server = $protocol.'://'.&hostname($spare_server); } return $spare_server; } @@ -3561,12 +3565,13 @@ sub privileged { sub rolesinit { my ($domain,$username,$authhost)=@_; + my %userroles; my $rolesdump=reply("dump:$domain:$username:roles",$authhost); - if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; } + if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return \%userroles; } my %allroles=(); my %allgroups=(); my $now=time; - my %userroles = ('user.login.time' => $now); + %userroles = ('user.login.time' => $now); my $group_privs; if ($rolesdump ne '') { @@ -5879,7 +5884,7 @@ sub assigncustomrole { sub revokerole { my ($udom,$uname,$url,$role,$deleteflag,$selfenroll,$context)=@_; my $now=time; - return &assignrole($udom,$uname,$url,$role,$now,$deleteflag,$selfenroll,$context); + return &assignrole($udom,$uname,$url,$role,$now,undef,$deleteflag,$selfenroll,$context); } # ---------------------------------------------------------- Revoke Custom Role @@ -8535,13 +8540,18 @@ sub get_dns { next if ($configline =~ /^(\#|\s*$ )/x); next if ($configline =~ /^\^/); chomp($configline); - my ($id,$domain,$role,$name)=split(/:/,$configline); + my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline); $name=~s/\s//g; if ($id && $domain && $role && $name) { $hostname{$id}=$name; push(@{$name_to_host{$name}}, $id); $hostdom{$id}=$domain; if ($role eq 'library') { $libserv{$id}=$name; } + if ($protocol eq 'https') { + $protocol{$id} = $protocol; + } else { + $protocol{$id} = 'http'; + } } } } @@ -8984,7 +8994,7 @@ when the connection is brought back up =item * B: unable to contact remote host and unable to save message for later delivery -=item * B: an error a occured, a description of the error follows the : +=item * B: an error a occurred, a description of the error follows the : =item * B: unable to fund a host associated with the user/domain that was requested @@ -9175,7 +9185,7 @@ Inputs: =item B<$uname> Student's loncapa login name -=item B<$uid> Student's id/student number +=item B<$uid> Student/Employee ID =item B<$umode> Student's authentication mode @@ -9564,7 +9574,7 @@ Returns: 'key_exists: ' -> failed to anything out of $storehash, as at least already existed in the db (other requested keys may also already exist) - 'error: ' -> unable to tie the DB or other erorr occured + 'error: ' -> unable to tie the DB or other error occurred 'con_lost' -> unable to contact request server 'refused' -> action was not allowed by remote machine