version 1.97, 2002/09/16 13:26:21
|
version 1.102, 2002/10/07 13:50:36
|
Line 129 sub lcpasswdstrerror {
|
Line 129 sub lcpasswdstrerror {
|
if(($ErrorCode < 0) || ($ErrorCode > $lastpwderror)) { |
if(($ErrorCode < 0) || ($ErrorCode > $lastpwderror)) { |
return "lcpasswd Unrecognized error return value ".$ErrorCode; |
return "lcpasswd Unrecognized error return value ".$ErrorCode; |
} else { |
} else { |
return $passwderrors($ErrorCode); |
return $passwderrors[$ErrorCode]; |
} |
} |
} |
} |
|
|
Line 141 sub lcuseraddstrerror {
|
Line 141 sub lcuseraddstrerror {
|
if(($ErrorCode < 0) || ($ErrorCode > $lastadderror)) { |
if(($ErrorCode < 0) || ($ErrorCode > $lastadderror)) { |
return "lcuseradd - Unrecognized error code: ".$ErrorCode; |
return "lcuseradd - Unrecognized error code: ".$ErrorCode; |
} else { |
} else { |
return $adderrors($ErrorCode); |
return $adderrors[$ErrorCode]; |
} |
} |
} |
} |
|
|
Line 695 sub make_new_child {
|
Line 695 sub make_new_child {
|
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
my $pwdcorrect=0; |
my $pwdcorrect=0; |
if ($howpwd eq 'internal') { |
if ($howpwd eq 'internal') { |
|
&Debug("Internal auth"); |
$pwdcorrect= |
$pwdcorrect= |
(crypt($upass,$contentpwd) eq $contentpwd); |
(crypt($upass,$contentpwd) eq $contentpwd); |
} elsif ($howpwd eq 'unix') { |
} elsif ($howpwd eq 'unix') { |
$contentpwd=(getpwnam($uname))[1]; |
&Debug("Unix auth"); |
my $pwauth_path="/usr/local/sbin/pwauth"; |
if((getpwnam($uname))[1] eq "") { #no such user! |
unless ($contentpwd eq 'x') { |
$pwdcorrect = 0; |
$pwdcorrect= |
} else { |
(crypt($upass,$contentpwd) eq $contentpwd); |
$contentpwd=(getpwnam($uname))[1]; |
} |
my $pwauth_path="/usr/local/sbin/pwauth"; |
|
unless ($contentpwd eq 'x') { |
|
$pwdcorrect= |
|
(crypt($upass,$contentpwd) eq |
|
$contentpwd); |
|
} |
|
|
elsif (-e $pwauth_path) { |
elsif (-e $pwauth_path) { |
open PWAUTH, "|$pwauth_path" or |
open PWAUTH, "|$pwauth_path" or |
die "Cannot invoke authentication"; |
die "Cannot invoke authentication"; |
Line 711 sub make_new_child {
|
Line 718 sub make_new_child {
|
close PWAUTH; |
close PWAUTH; |
$pwdcorrect=!$?; |
$pwdcorrect=!$?; |
} |
} |
|
} |
} elsif ($howpwd eq 'krb4') { |
} elsif ($howpwd eq 'krb4') { |
$null=pack("C",0); |
$null=pack("C",0); |
unless ($upass=~/$null/) { |
unless ($upass=~/$null/) { |
Line 759 sub make_new_child {
|
Line 767 sub make_new_child {
|
chomp($npass); |
chomp($npass); |
$upass=&unescape($upass); |
$upass=&unescape($upass); |
$npass=&unescape($npass); |
$npass=&unescape($npass); |
&logthis("Trying to change password for $uname"); |
&Debug("Trying to change password for $uname"); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $passfilename="$proname/passwd"; |
my $passfilename="$proname/passwd"; |
if (-e $passfilename) { |
if (-e $passfilename) { |
Line 769 sub make_new_child {
|
Line 777 sub make_new_child {
|
chomp($realpasswd); |
chomp($realpasswd); |
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
if ($howpwd eq 'internal') { |
if ($howpwd eq 'internal') { |
|
&Debug("internal auth"); |
if (crypt($upass,$contentpwd) eq $contentpwd) { |
if (crypt($upass,$contentpwd) eq $contentpwd) { |
my $salt=time; |
my $salt=time; |
$salt=substr($salt,6,2); |
$salt=substr($salt,6,2); |
Line 785 sub make_new_child {
|
Line 794 sub make_new_child {
|
# one way or another. |
# one way or another. |
# First: Make sure the current password is |
# First: Make sure the current password is |
# correct |
# correct |
|
&Debug("auth is unix"); |
$contentpwd=(getpwnam($uname))[1]; |
$contentpwd=(getpwnam($uname))[1]; |
my $pwdcorrect = "0"; |
my $pwdcorrect = "0"; |
my $pwauth_path="/usr/local/sbin/pwauth"; |
my $pwauth_path="/usr/local/sbin/pwauth"; |
Line 796 sub make_new_child {
|
Line 806 sub make_new_child {
|
die "Cannot invoke authentication"; |
die "Cannot invoke authentication"; |
print PWAUTH "$uname\n$upass\n"; |
print PWAUTH "$uname\n$upass\n"; |
close PWAUTH; |
close PWAUTH; |
my $pwdcorrect=!$?; |
&Debug("exited pwauth with $? ($uname,$upass) "); |
|
$pwdcorrect=($? == 0); |
} |
} |
if ($pwdcorrect) { |
if ($pwdcorrect) { |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
my $pf = IO::File->new("|$execdir/lcpasswd"); |
&Debug("Opening lcpasswd pipeline"); |
|
my $pf = IO::File->new("|$execdir/lcpasswd > /home/www/lcpasswd.log"); |
print $pf "$uname\n$npass\n$npass\n"; |
print $pf "$uname\n$npass\n$npass\n"; |
close $pf; |
close $pf; |
my $err = $?; |
my $err = $?; |
Line 853 sub make_new_child {
|
Line 865 sub make_new_child {
|
} |
} |
} |
} |
unless ($fperror) { |
unless ($fperror) { |
my $result=&make_passwd_file($umode,$npass, |
my $result=&make_passwd_file($uname, $umode,$npass, |
$passfilename); |
$passfilename); |
print $client $result; |
print $client $result; |
} else { |
} else { |
Line 879 sub make_new_child {
|
Line 891 sub make_new_child {
|
if ($udom ne $perlvar{'lonDefDomain'}) { |
if ($udom ne $perlvar{'lonDefDomain'}) { |
print $client "not_right_domain\n"; |
print $client "not_right_domain\n"; |
} else { |
} else { |
my $result=&make_passwd_file($umode,$npass, |
my $result=&make_passwd_file($uname, $umode,$npass, |
$passfilename); |
$passfilename); |
print $client $result; |
print $client $result; |
} |
} |
Line 1003 sub make_new_child {
|
Line 1015 sub make_new_child {
|
# ------------------------------------------------------------------- subscribe |
# ------------------------------------------------------------------- subscribe |
} elsif ($userinput =~ /^sub/) { |
} elsif ($userinput =~ /^sub/) { |
print $client &subscribe($userinput,$clientip); |
print $client &subscribe($userinput,$clientip); |
|
# ------------------------------------------------------------- current version |
|
} elsif ($userinput =~ /^currentversion/) { |
|
my ($cmd,$fname)=split(/:/,$userinput); |
|
print $client ¤tversion($fname)."\n"; |
# ------------------------------------------------------------------------- log |
# ------------------------------------------------------------------------- log |
} elsif ($userinput =~ /^log/) { |
} elsif ($userinput =~ /^log/) { |
my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); |
my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); |
Line 1212 sub make_new_child {
|
Line 1228 sub make_new_child {
|
} else { |
} else { |
$regexp='.'; |
$regexp='.'; |
} |
} |
my $proname=propath($udom,$uname); |
|
my $qresult=''; |
my $qresult=''; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { |
my $proname=propath($udom,$uname); |
|
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { |
study($regexp); |
study($regexp); |
foreach $key (keys %hash) { |
while (($key,$value) = each(%hash)) { |
my $unescapeKey = &unescape($key); |
if ($regexp eq '.') { |
if (eval('$unescapeKey=~/$regexp/')) { |
$qresult.=$key.'='.$value.'&'; |
$qresult.="$key=$hash{$key}&"; |
} else { |
} |
my $unescapeKey = &unescape($key); |
|
if (eval('$unescapeKey=~/$regexp/')) { |
|
$qresult.="$key=$value&"; |
|
} |
|
} |
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
$qresult=~s/\&$//; |
chop($qresult); |
print $client "$qresult\n"; |
print $client "$qresult\n"; |
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
} |
} |
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
Line 1631 sub unsub {
|
Line 1651 sub unsub {
|
return $result; |
return $result; |
} |
} |
|
|
|
sub currentversion { |
|
my $fname=shift; |
|
my $version=-1; |
|
my $ulsdir=''; |
|
if ($fname=~/^(.+)\/[^\/]+$/) { |
|
$ulsdir=$1; |
|
} |
|
$fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/; |
|
$fname=~s/\.(\w+(?:\.meta)*)$/\.\(\\d\+\)\.$1\$/; |
|
|
|
if (-e $fname) { $version=1; } |
|
if (-e $ulsdir) { |
|
if(-d $ulsdir) { |
|
if (opendir(LSDIR,$ulsdir)) { |
|
while ($ulsfn=readdir(LSDIR)) { |
|
# see if this is a regular file (ignore links produced earlier) |
|
my $thisfile=$ulsdir.'/'.$ulsfn; |
|
unless (-l $thisfile) { |
|
if ($thisfile=~/$fname/) { |
|
if ($1>$version) { $version=$1; } |
|
} |
|
} |
|
} |
|
closedir(LSDIR); |
|
$version++; |
|
} |
|
} |
|
} |
|
return $version; |
|
} |
|
|
|
sub thisversion { |
|
my $fname=shift; |
|
my $version=-1; |
|
if ($fname=~/\.(\d+)\.\w+(?:\.meta)*$/) { |
|
$version=$1; |
|
} |
|
return $version; |
|
} |
|
|
sub subscribe { |
sub subscribe { |
my ($userinput,$clientip)=@_; |
my ($userinput,$clientip)=@_; |
my $result; |
my $result; |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
my $ownership=&ishome($fname); |
my $ownership=&ishome($fname); |
if ($ownership eq 'owner') { |
if ($ownership eq 'owner') { |
|
# explitly asking for the current version? |
|
unless (-e $fname) { |
|
my $currentversion=¤tversion($fname); |
|
if (&thisversion($fname)==$currentversion) { |
|
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { |
|
my $root=$1; |
|
my $extension=$2; |
|
symlink($root.'.'.$extension, |
|
$root.'.'.$currentversion.'.'.$extension); |
|
unless ($extension=~/\.meta$/) { |
|
symlink($root.'.'.$extension.'.meta', |
|
$root.'.'.$currentversion.'.'.$extension.'.meta'); |
|
} |
|
} |
|
} |
|
} |
if (-e $fname) { |
if (-e $fname) { |
if (-d $fname) { |
if (-d $fname) { |
$result="directory\n"; |
$result="directory\n"; |
Line 1664 sub subscribe {
|
Line 1740 sub subscribe {
|
} |
} |
|
|
sub make_passwd_file { |
sub make_passwd_file { |
my ($umode,$npass,$passfilename)=@_; |
my ($uname, $umode,$npass,$passfilename)=@_; |
my $result="ok\n"; |
my $result="ok\n"; |
if ($umode eq 'krb4' or $umode eq 'krb5') { |
if ($umode eq 'krb4' or $umode eq 'krb5') { |
{ |
{ |
Line 1690 sub make_passwd_file {
|
Line 1766 sub make_passwd_file {
|
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
{ |
{ |
&Debug("Executing external: ".$execpath); |
&Debug("Executing external: ".$execpath); |
my $se = IO::File->new("|$execpath"); |
&Debug("user = ".$uname.", Password =". $npass); |
|
my $se = IO::File->new("|$execpath > /home/www/lcuseradd.log"); |
print $se "$uname\n"; |
print $se "$uname\n"; |
print $se "$npass\n"; |
print $se "$npass\n"; |
print $se "$npass\n"; |
print $se "$npass\n"; |