|
version 1.178.2.13, 2004/03/23 11:50:12
|
version 1.178.2.21, 2004/04/29 10:35:07
|
|
Line 796 sub ChangePasswordHandler {
|
Line 796 sub ChangePasswordHandler {
|
| # First require that the user can be authenticated with their |
# First require that the user can be authenticated with their |
| # old password: |
# old password: |
| |
|
| my $validated = ValidUser($udom, $uname, $upass); |
my $validated = ValidateUser($udom, $uname, $upass); |
| if($validated) { |
if($validated) { |
| my $realpasswd = GetAuthType($udom, $uname); # Defined since authd. |
my $realpasswd = GetAuthType($udom, $uname); # Defined since authd. |
| |
|
|
Line 890 sub AddUserHandler {
|
Line 890 sub AddUserHandler {
|
| for (my $i=3;$i<= ($#fpparts-1);$i++) { |
for (my $i=3;$i<= ($#fpparts-1);$i++) { |
| $fpnow.='/'.$fpparts[$i]; |
$fpnow.='/'.$fpparts[$i]; |
| unless (-e $fpnow) { |
unless (-e $fpnow) { |
| |
&logthis("mkdir $fpnow"); |
| unless (mkdir($fpnow,0777)) { |
unless (mkdir($fpnow,0777)) { |
| $fperror="error: ".($!+0)." mkdir failed while attempting " |
$fperror="error: ".($!+0)." mkdir failed while attempting " |
| ."makeuser"; |
."makeuser"; |
|
Line 989 sub IsHomeHandler {
|
Line 990 sub IsHomeHandler {
|
| |
|
| my ($udom,$uname)=split(/:/,$tail); |
my ($udom,$uname)=split(/:/,$tail); |
| chomp($uname); |
chomp($uname); |
| my $passfile = PasswordPath($udom, $uname); |
my $passfile = PasswordFilename($udom, $uname); |
| if($passfile) { |
if($passfile) { |
| Reply( $client, "found\n", $userinput); |
Reply( $client, "found\n", $userinput); |
| } else { |
} else { |
|
Line 1027 sub UpdateResourceHandler {
|
Line 1028 sub UpdateResourceHandler {
|
| |
|
| my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
| |
|
| my $fname=$tail; |
my $fname=split(/:/,$tail); # This allows interactive testing |
| |
chomp($fname); # with telnet. |
| |
|
| my $ownership=ishome($fname); |
my $ownership=ishome($fname); |
| if ($ownership eq 'not_owner') { |
if ($ownership eq 'not_owner') { |
| if (-e $fname) { |
if (-e $fname) { |
|
Line 1137 sub FetchUserFileHandler {
|
Line 1140 sub FetchUserFileHandler {
|
| } |
} |
| RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0); |
RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0); |
| # |
# |
| # Authenticate access to a user file. Question? The token for athentication |
# Authenticate access to a user file. |
| # is allowed to be sent as cleartext is this really what we want? This token |
|
| # represents the user's session id. Once it is forged does this allow too much |
|
| # access?? |
|
| # |
# |
| # Parameters: |
# Parameters: |
| # $cmd - The command that got us here. |
# $cmd - The command that got us here. |
|
Line 1190 sub UnsubscribeHandler {
|
Line 1190 sub UnsubscribeHandler {
|
| my $client = shift; |
my $client = shift; |
| my $userinput= "$cmd:$tail"; |
my $userinput= "$cmd:$tail"; |
| |
|
| my $fname = $tail; |
my ($fname) = split(/:/,$tail); # This allows for interactive testing |
| |
# e.g. manual telnet and unsub:res: |
| |
# Otherwise the \r gets in the way. |
| |
chomp($fname); |
| |
Debug("Unsubscribing $fname"); |
| if (-e $fname) { |
if (-e $fname) { |
| Reply($client, &unsub($client,$fname,$clientip), $userinput); |
Debug("Exists"); |
| |
Reply($client, &unsub($fname,$clientip), $userinput); |
| } else { |
} else { |
| Failure($client, "not_found\n", $userinput); |
Failure($client, "not_found\n", $userinput); |
| } |
} |
| return 1; |
return 1; |
| } |
} |
| RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0); |
RegisterHandler("unsub", \&UnsubscribeHandler, 0, 1, 0); |
| |
|
| # Subscribe to a resource |
# Subscribe to a resource |
| # |
# |
|
Line 1412 sub RolesPutHandler {
|
Line 1417 sub RolesPutHandler {
|
| my $client = shift; |
my $client = shift; |
| my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
| |
|
| my ($exedom,$exeuser,$udom,$uname,$what) =split(/:/,$tail); |
my ( $exedom, $exeuser, $udom, $uname, $what) = split(/:/,$tail); |
| &Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom. |
|
| "what = ".$what); |
|
| my $namespace='roles'; |
my $namespace='roles'; |
| chomp($what); |
chomp($what); |
| my $hashref = TieUserHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
|
Line 1616 sub GetProfileEntryEncrypted {
|
Line 1621 sub GetProfileEntryEncrypted {
|
| |
|
| return 1; |
return 1; |
| } |
} |
| RegisterHandler("eget", \&GetProfileEncrypted, 0, 1, 0); |
RegisterHandler("eget", \&GetProfileEntryEncrypted, 0, 1, 0); |
| |
|
| # |
# |
| # Deletes a key in a user profile database. |
# Deletes a key in a user profile database. |
|
Line 1847 sub DumpWithRegexp {
|
Line 1852 sub DumpWithRegexp {
|
| } |
} |
| RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
| |
|
| # Store an aitem in any database but the roles database. |
# Store an aitem in any resource meta data(?) or database with |
| |
# versioning? |
| # |
# |
| # Parameters: |
# Parameters: |
| # $cmd - Request command keyword. |
# $cmd - Request command keyword. |
|
Line 2222 sub DumpCourseIdHandler {
|
Line 2228 sub DumpCourseIdHandler {
|
| } |
} |
| unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
| my $qresult=''; |
my $qresult=''; |
| |
logthis(" Looking for $description since $since"); |
| my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
| if ($hashref) { |
if ($hashref) { |
| while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
| my ($descr,$lasttime)=split(/\:/,$value); |
my ($descr,$lasttime)=split(/\:/,$value); |
| |
logthis("Got: key = $key descr = $descr time: $lasttime"); |
| if ($lasttime<$since) { |
if ($lasttime<$since) { |
| |
logthis("Skipping .. too early"); |
| next; |
next; |
| } |
} |
| if ($description eq '.') { |
if ($description eq '.') { |
| |
logthis("Adding wildcard match"); |
| $qresult.=$key.'='.$descr.'&'; |
$qresult.=$key.'='.$descr.'&'; |
| } else { |
} else { |
| my $unescapeVal = &unescape($descr); |
my $unescapeVal = &unescape($descr); |
| |
logthis("Matching with $unescapeVal"); |
| if (eval('$unescapeVal=~/$description/i')) { |
if (eval('$unescapeVal=~/$description/i')) { |
| |
logthis("Adding on match"); |
| $qresult.="$key=$descr&"; |
$qresult.="$key=$descr&"; |
| } |
} |
| } |
} |
|
Line 2492 sub LsHandler {
|
Line 2503 sub LsHandler {
|
| |
|
| my $userinput = "$cmd:$ulsdir"; |
my $userinput = "$cmd:$ulsdir"; |
| |
|
| |
chomp($ulsdir); |
| |
|
| my $ulsout=''; |
my $ulsout=''; |
| my $ulsfn; |
my $ulsfn; |
| |
logthis("ls for '$ulsdir'"); |
| if (-e $ulsdir) { |
if (-e $ulsdir) { |
| |
logthis("ls - directory exists"); |
| if(-d $ulsdir) { |
if(-d $ulsdir) { |
| |
logthis("ls $ulsdir is a file"); |
| if (opendir(LSDIR,$ulsdir)) { |
if (opendir(LSDIR,$ulsdir)) { |
| while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
| my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
|
Line 2679 sub ProcessRequest {
|
Line 2695 sub ProcessRequest {
|
| # Split off the request keyword from the rest of the stuff. |
# Split off the request keyword from the rest of the stuff. |
| |
|
| my ($command, $tail) = split(/:/, $userinput, 2); |
my ($command, $tail) = split(/:/, $userinput, 2); |
| |
chomp($command); |
| |
chomp($tail); |
| |
|
| Debug("Command received: $command, encoded = $wasenc"); |
Debug("Command received: $command, encoded = $wasenc"); |
| |
|
|
Line 2720 sub ProcessRequest {
|
Line 2738 sub ProcessRequest {
|
| $KeepGoing = &$Handler($command, $tail, $client); |
$KeepGoing = &$Handler($command, $tail, $client); |
| } else { |
} else { |
| Debug("Refusing to dispatch because ok is false"); |
Debug("Refusing to dispatch because ok is false"); |
| Failure($client, "refused", $userinput); |
Failure($client, "refused\n", $userinput); |
| } |
} |
| |
|
| |
|
|
Line 3807 sub propath {
|
Line 3825 sub propath {
|
| |
|
| sub ishome { |
sub ishome { |
| my $author=shift; |
my $author=shift; |
| |
Debug("ishome: $author"); |
| $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
| |
Debug(" after big regsub: $author"); |
| my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
| |
Debug(" domain: $udom user: $uname"); |
| my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
| |
Debug(" path = $proname"); |
| if (-e $proname) { |
if (-e $proname) { |
| return 'owner'; |
return 'owner'; |
| } else { |
} else { |
|
Line 4035 sub ManagePermissions {
|
Line 4057 sub ManagePermissions {
|
| my $authtype= shift; |
my $authtype= shift; |
| |
|
| # See if the request is of the form /$domain/_au |
# See if the request is of the form /$domain/_au |
| &logthis("ruequest is $request"); |
&logthis("request is $request"); |
| if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
| my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
| my $userhome= "/home/$user" ; |
my $userhome= "/home/$user" ; |
|
Line 4185 sub ValidateUser {
|
Line 4207 sub ValidateUser {
|
| $validated = (crypt($password, $contentpwd) eq $contentpwd); |
$validated = (crypt($password, $contentpwd) eq $contentpwd); |
| } |
} |
| elsif ($howpwd eq "unix") { # User is a normal unix user. |
elsif ($howpwd eq "unix") { # User is a normal unix user. |
| $contentpwd = (getpwname($user))[1]; |
$contentpwd = (getpwnam($user))[1]; |
| if($contentpwd) { |
if($contentpwd) { |
| if($contentpwd eq 'x') { # Shadow password file... |
if($contentpwd eq 'x') { # Shadow password file... |
| my $pwauth_path = "/usr/local/sbin/pwauth"; |
my $pwauth_path = "/usr/local/sbin/pwauth"; |
|
Line 4275 sub addline {
|
Line 4297 sub addline {
|
| my $expr='^'.$hostid.':'.$ip.':'; |
my $expr='^'.$hostid.':'.$ip.':'; |
| $expr =~ s/\./\\\./g; |
$expr =~ s/\./\\\./g; |
| my $sh; |
my $sh; |
| |
Debug("Looking for $expr"); |
| if ($sh=IO::File->new("$fname.subscription")) { |
if ($sh=IO::File->new("$fname.subscription")) { |
| while (my $subline=<$sh>) { |
while (my $subline=<$sh>) { |
| if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;} |
Debug("addline: line: $subline"); |
| |
if ($subline !~ /$expr/) { |
| |
$contents.= $subline; |
| |
} else { |
| |
Debug("Found $subline"); |
| |
$found=1; |
| |
} |
| } |
} |
| $sh->close(); |
$sh->close(); |
| } |
} |
| $sh=IO::File->new(">$fname.subscription"); |
$sh=IO::File->new(">$fname.subscription"); |
| if ($contents) { print $sh $contents; } |
if ($contents) { print $sh $contents; } |
| if ($newline) { print $sh $newline; } |
if ($newline) { |
| |
Debug("Appending $newline"); |
| |
print $sh $newline; |
| |
} |
| $sh->close(); |
$sh->close(); |
| return $found; |
return $found; |
| } |
} |
|
Line 4356 sub chatadd {
|
Line 4388 sub chatadd {
|
| sub unsub { |
sub unsub { |
| my ($fname,$clientip)=@_; |
my ($fname,$clientip)=@_; |
| my $result; |
my $result; |
| |
my $unsubs = 0; # Number of successful unsubscribes: |
| |
|
| |
|
| |
# An old way subscriptions were handled was to have a |
| |
# subscription marker file: |
| |
|
| |
Debug("Attempting unlink of $fname.$clientname"); |
| if (unlink("$fname.$clientname")) { |
if (unlink("$fname.$clientname")) { |
| $result="ok\n"; |
$unsubs++; # Successful unsub via marker file. |
| } else { |
} |
| $result="not_subscribed\n"; |
|
| } |
# The more modern way to do it is to have a subscription list |
| |
# file: |
| |
|
| if (-e "$fname.subscription") { |
if (-e "$fname.subscription") { |
| my $found=&addline($fname,$clientname,$clientip,''); |
my $found=&addline($fname,$clientname,$clientip,''); |
| if ($found) { $result="ok\n"; } |
if ($found) { |
| |
$unsubs++; |
| |
} |
| |
} |
| |
|
| |
# If either or both of these mechanisms succeeded in unsubscribing a |
| |
# resource we can return ok: |
| |
|
| |
if($unsubs) { |
| |
$result = "ok\n"; |
| } else { |
} else { |
| if ($result != "ok\n") { $result="not_subscribed\n"; } |
$result = "not_subscribed\n"; |
| } |
} |
| |
|
| return $result; |
return $result; |
| } |
} |
| |
|
|
Line 4418 sub thisversion {
|
Line 4469 sub thisversion {
|
| |
|
| sub subscribe { |
sub subscribe { |
| my ($userinput,$clientip)=@_; |
my ($userinput,$clientip)=@_; |
| |
chomp($userinput); |
| my $result; |
my $result; |
| my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
| my $ownership=&ishome($fname); |
my $ownership=&ishome($fname); |
| |
Debug("subscribe: Owner = $ownership file: '$fname'"); |
| if ($ownership eq 'owner') { |
if ($ownership eq 'owner') { |
| # explitly asking for the current version? |
# explitly asking for the current version? |
| unless (-e $fname) { |
unless (-e $fname) { |
| |
Debug("subscribe - does not exist"); |
| my $currentversion=¤tversion($fname); |
my $currentversion=¤tversion($fname); |
| if (&thisversion($fname)==$currentversion) { |
if (&thisversion($fname)==$currentversion) { |
| if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { |
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { |
|
Line 4439 sub subscribe {
|
Line 4493 sub subscribe {
|
| } |
} |
| } |
} |
| if (-e $fname) { |
if (-e $fname) { |
| |
Debug("subscribe - exists"); |
| if (-d $fname) { |
if (-d $fname) { |
| $result="directory\n"; |
$result="directory\n"; |
| } else { |
} else { |
|
Line 4487 sub make_passwd_file {
|
Line 4542 sub make_passwd_file {
|
| print $pf "localauth:$npass\n"; |
print $pf "localauth:$npass\n"; |
| } |
} |
| } elsif ($umode eq 'unix') { |
} elsif ($umode eq 'unix') { |
| { |
# |
| my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
# Don't allow the creation of privileged accounts!!! that would |
| { |
# be real bad!!! |
| &Debug("Executing external: ".$execpath); |
# |
| &Debug("user = ".$uname.", Password =". $npass); |
my $uid = getpwnam($uname); |
| my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); |
if((defined $uid) && ($uid == 0)) { |
| print $se "$uname\n"; |
&logthis(">>>Attempted add of privileged account blocked<<<"); |
| print $se "$npass\n"; |
return "no_priv_account_error\n"; |
| print $se "$npass\n"; |
} |
| } |
|
| my $useraddok = $?; |
# |
| if($useraddok > 0) { |
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
| &logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok)); |
|
| } |
&Debug("Executing external: ".$execpath); |
| my $pf = IO::File->new(">$passfilename"); |
&Debug("user = ".$uname.", Password =". $npass); |
| print $pf "unix:\n"; |
my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); |
| |
print $se "$uname\n"; |
| |
print $se "$npass\n"; |
| |
print $se "$npass\n"; |
| |
|
| |
my $useraddok = $?; |
| |
if($useraddok > 0) { |
| |
my $lcstring = lcuseraddstrerror($useraddok); |
| |
&logthis("Failed lcuseradd: $lcstring"); |
| |
return "error: lcuseradd failed: $lcstring\n"; |
| } |
} |
| |
my $pf = IO::File->new(">$passfilename"); |
| |
print $pf "unix:\n"; |
| |
|
| } elsif ($umode eq 'none') { |
} elsif ($umode eq 'none') { |
| { |
{ |
| my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |
|
Line 4517 sub make_passwd_file {
|
Line 4584 sub make_passwd_file {
|
| |
|
| sub sethost { |
sub sethost { |
| my ($remotereq) = @_; |
my ($remotereq) = @_; |
| |
Debug("sethost got $remotereq"); |
| my (undef,$hostid)=split(/:/,$remotereq); |
my (undef,$hostid)=split(/:/,$remotereq); |
| if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
| |
Debug("sethost attempting to set host $hostid"); |
| if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
| $currenthostid=$hostid; |
$currenthostid=$hostid; |
| $currentdomainid=$hostdom{$hostid}; |
$currentdomainid=$hostdom{$hostid}; |
![[BACK]](/icons/back.gif){kind=icon}
Return to lond CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom