version 1.352, 2006/11/27 23:10:27
|
version 1.360, 2007/01/28 19:23:25
|
Line 44 use Digest::MD5 qw(md5_hex);
|
Line 44 use Digest::MD5 qw(md5_hex);
|
use GDBM_File; |
use GDBM_File; |
use Authen::Krb4; |
use Authen::Krb4; |
use Authen::Krb5; |
use Authen::Krb5; |
use lib '/home/httpd/lib/perl/'; |
|
use localauth; |
use localauth; |
use localenroll; |
use localenroll; |
use localstudentphoto; |
use localstudentphoto; |
Line 504 sub AdjustHostContents {
|
Line 503 sub AdjustHostContents {
|
my $adjusted; |
my $adjusted; |
my $me = $perlvar{'lonHostID'}; |
my $me = $perlvar{'lonHostID'}; |
|
|
foreach my $line (split(/\n/,$contents)) { |
foreach my $line (split(/\n/,$contents)) { |
if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) { |
if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) { |
chomp($line); |
chomp($line); |
my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line); |
my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line); |
if ($id eq $me) { |
if ($id eq $me) { |
my $ip = gethostbyname($name); |
my $ip = gethostbyname($name); |
my $ipnew = inet_ntoa($ip); |
my $ipnew = inet_ntoa($ip); |
$ip = $ipnew; |
$ip = $ipnew; |
# Reconstruct the host line and append to adjusted: |
# Reconstruct the host line and append to adjusted: |
|
|
my $newline = "$id:$domain:$role:$name:$ip"; |
my $newline = "$id:$domain:$role:$name:$ip"; |
if($maxcon ne "") { # Not all hosts have loncnew tuning params |
if($maxcon ne "") { # Not all hosts have loncnew tuning params |
$newline .= ":$maxcon:$idleto:$mincon"; |
$newline .= ":$maxcon:$idleto:$mincon"; |
} |
} |
$adjusted .= $newline."\n"; |
$adjusted .= $newline."\n"; |
|
|
} else { # Not me, pass unmodified. |
} else { # Not me, pass unmodified. |
$adjusted .= $line."\n"; |
$adjusted .= $line."\n"; |
} |
} |
} else { # Blank or comment never re-written. |
} else { # Blank or comment never re-written. |
$adjusted .= $line."\n"; # Pass blanks and comments as is. |
$adjusted .= $line."\n"; # Pass blanks and comments as is. |
} |
} |
} |
} |
return $adjusted; |
return $adjusted; |
} |
} |
# |
# |
# InstallFile: Called to install an administrative file: |
# InstallFile: Called to install an administrative file: |
Line 3293 sub put_course_id_handler {
|
Line 3292 sub put_course_id_handler {
|
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$courseinfo) = split(/=/,$pair,2); |
my ($key,$courseinfo) = split(/=/,$pair,2); |
$courseinfo =~ s/=/:/g; |
$courseinfo =~ s/=/:/g; |
|
my @current_items = split(/:/,$hashref->{$key},-1); |
my @current_items = split(/:/,$hashref->{$key}); |
|
shift(@current_items); # remove description |
shift(@current_items); # remove description |
pop(@current_items); # remove last access |
pop(@current_items); # remove last access |
my $numcurrent = scalar(@current_items); |
my $numcurrent = scalar(@current_items); |
|
if ($numcurrent > 3) { |
my @new_items = split(/:/,$courseinfo); |
$numcurrent = 3; |
|
} |
|
my @new_items = split(/:/,$courseinfo,-1); |
my $numnew = scalar(@new_items); |
my $numnew = scalar(@new_items); |
if ($numcurrent > 0) { |
if ($numcurrent > 0) { |
if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 |
if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 |
Line 3599 sub get_domain_handler {
|
Line 3599 sub get_domain_handler {
|
|
|
return 1; |
return 1; |
} |
} |
®ister_handler("getdom", \&get_id_handler, 0, 1, 0); |
®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); |
|
|
|
|
# |
# |
Line 5466 sub make_new_child {
|
Line 5466 sub make_new_child {
|
# my $tmpsnum=0; # Now global |
# my $tmpsnum=0; # Now global |
#---------------------------------------------------- kerberos 5 initialization |
#---------------------------------------------------- kerberos 5 initialization |
&Authen::Krb5::init_context(); |
&Authen::Krb5::init_context(); |
unless (($dist eq 'fedora5') || ($dist eq 'fedora4') |
unless (($dist eq 'fedora5') || ($dist eq 'fedora4') || |
|| ($dist eq 'suse9.3')) { |
($dist eq 'fedora6') || ($dist eq 'suse9.3')) { |
&Authen::Krb5::init_ets(); |
&Authen::Krb5::init_ets(); |
} |
} |
|
|
Line 5880 sub validate_user {
|
Line 5880 sub validate_user {
|
my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd; |
my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd; |
my $krbserver = &Authen::Krb5::parse_name($krbservice); |
my $krbserver = &Authen::Krb5::parse_name($krbservice); |
my $credentials= &Authen::Krb5::cc_default(); |
my $credentials= &Authen::Krb5::cc_default(); |
$credentials->initialize($krbclient); |
$credentials->initialize(&Authen::Krb5::parse_name($user.'@' |
|
.$contentpwd)); |
my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient, |
my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient, |
$krbserver, |
$krbserver, |
$password, |
$password, |
Line 5893 sub validate_user {
|
Line 5894 sub validate_user {
|
# Authenticate via installation specific authentcation method: |
# Authenticate via installation specific authentcation method: |
$validated = &localauth::localauth($user, |
$validated = &localauth::localauth($user, |
$password, |
$password, |
$contentpwd); |
$contentpwd, |
|
$domain); |
|
if ($validated < 0) { |
|
&logthis("localauth for $contentpwd $user:$domain returned a $validated"); |
|
$validated = 0; |
|
} |
} else { # Unrecognized auth is also bad. |
} else { # Unrecognized auth is also bad. |
$validated = 0; |
$validated = 0; |
} |
} |
Line 5919 sub addline {
|
Line 5925 sub addline {
|
my ($fname,$hostid,$ip,$newline)=@_; |
my ($fname,$hostid,$ip,$newline)=@_; |
my $contents; |
my $contents; |
my $found=0; |
my $found=0; |
my $expr='^'.$hostid.':'.$ip.':'; |
my $expr='^'.quotemeta($hostid).':'.quotemeta($ip).':'; |
$expr =~ s/\./\\\./g; |
|
my $sh; |
my $sh; |
if ($sh=IO::File->new("$fname.subscription")) { |
if ($sh=IO::File->new("$fname.subscription")) { |
while (my $subline=<$sh>) { |
while (my $subline=<$sh>) { |