version 1.989, 2009/03/09 03:49:17
|
version 1.993, 2009/04/11 14:47:51
|
Line 74 use strict;
|
Line 74 use strict;
|
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use HTTP::Date; |
use HTTP::Date; |
use Image::Magick; |
use Image::Magick; |
use IO::Socket; |
|
|
|
# use Date::Parse; |
|
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol); |
$_64bit %env %protocol); |
|
|
Line 198 sub get_server_timezone {
|
Line 196 sub get_server_timezone {
|
} |
} |
} |
} |
|
|
|
sub get_server_loncaparev { |
|
my ($dom,$lonhost) = @_; |
|
if (defined($lonhost)) { |
|
if (!defined(&hostname($lonhost))) { |
|
undef($lonhost); |
|
} |
|
} |
|
if (!defined($lonhost)) { |
|
if (defined(&domain($dom,'primary'))) { |
|
$lonhost=&domain($dom,'primary'); |
|
if ($lonhost eq 'no_host') { |
|
undef($lonhost); |
|
} |
|
} |
|
} |
|
if (defined($lonhost)) { |
|
my $cachetime = 24*3600; |
|
my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost); |
|
if (defined($cached)) { |
|
return $loncaparev; |
|
} else { |
|
my $loncaparev = &reply('serverloncaparev',$lonhost); |
|
return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime); |
|
} |
|
} |
|
} |
|
|
# -------------------------------------------------- Non-critical communication |
# -------------------------------------------------- Non-critical communication |
sub subreply { |
sub subreply { |
my ($cmd,$server)=@_; |
my ($cmd,$server)=@_; |
Line 5951 sub modifyuser {
|
Line 5976 sub modifyuser {
|
sub modifystudent { |
sub modifystudent { |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
$end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid, |
$end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid, |
$selfenroll,$context)=@_; |
$selfenroll,$context,$inststatus)=@_; |
if (!$cid) { |
if (!$cid) { |
unless ($cid=$env{'request.course.id'}) { |
unless ($cid=$env{'request.course.id'}) { |
return 'not_in_class'; |
return 'not_in_class'; |
Line 5960 sub modifystudent {
|
Line 5985 sub modifystudent {
|
# --------------------------------------------------------------- Make the user |
# --------------------------------------------------------------- Make the user |
my $reply=&modifyuser |
my $reply=&modifyuser |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
$desiredhome,$email); |
$desiredhome,$email,$inststatus); |
unless ($reply eq 'ok') { return $reply; } |
unless ($reply eq 'ok') { return $reply; } |
# This will cause &modify_student_enrollment to get the uid from the |
# This will cause &modify_student_enrollment to get the uid from the |
# students environment |
# students environment |
Line 9048 sub get_dns {
|
Line 9073 sub get_dns {
|
|
|
return %iphost; |
return %iphost; |
} |
} |
} |
|
|
|
# |
# |
# Given a DNS returns the loncapa host name for that DNS |
# Given a DNS returns the loncapa host name for that DNS |
# |
# |
sub host_from_dns { |
sub host_from_dns { |
my ($dns) = @_; |
my ($dns) = @_; |
my @hosts; |
my @hosts; |
my $ip; |
my $ip; |
|
|
$ip = gethostbyname($dns); # Initial translation to IP is in net order. |
if (exists($name_to_ip{$dns})) { |
if (length($ip) == 4) { |
$ip = $name_to_ip{$dns}; |
$ip = &IO::Socket::inet_ntoa($ip); |
} |
@hosts = get_hosts_from_ip($ip); |
if (!$ip) { |
return $hosts[0]; |
$ip = gethostbyname($dns); # Initial translation to IP is in net order. |
|
if (length($ip) == 4) { |
|
$ip = &IO::Socket::inet_ntoa($ip); |
|
} |
|
} |
|
if ($ip) { |
|
@hosts = get_hosts_from_ip($ip); |
|
return $hosts[0]; |
|
} |
|
return undef; |
} |
} |
return undef; |
|
} |
} |
|
|
BEGIN { |
BEGIN { |