version 1.178.2.8, 2004/03/16 10:52:30
|
version 1.178.2.11, 2004/03/22 09:41:53
|
Line 162 sub isClient {
|
Line 162 sub isClient {
|
return (($ConnectionType eq "client") || ($ConnectionType eq "both")); |
return (($ConnectionType eq "client") || ($ConnectionType eq "both")); |
} |
} |
# |
# |
# Ties a resource file to a hash. If necessary, an appropriate history |
# Ties a domain level resource file to a hash. |
|
# If requested a history entry is created in the associated hist file. |
|
# |
|
# Parameters: |
|
# domain - Name of the domain in which the resource file lives. |
|
# namespace - Name of the hash within that domain. |
|
# how - How to tie the hash (e.g. GDBM_WRCREAT()). |
|
# loghead - Optional parameter, if present a log entry is created |
|
# in the associated history file and this is the first part |
|
# of that entry. |
|
# logtail - Goes along with loghead, The actual logentry is of the |
|
# form $loghead:<timestamp>:logtail. |
|
# Returns: |
|
# Reference to a hash bound to the db file or alternatively undef |
|
# if the tie failed. |
|
# |
|
sub TieDomainHash { |
|
my $domain = shift; |
|
my $namespace = shift; |
|
my $how = shift; |
|
|
|
# Filter out any whitespace in the domain name: |
|
|
|
$domain =~ s/\W//g; |
|
|
|
# We have enough to go on to tie the hash: |
|
|
|
my $UserTopDir = $perlvar{'lonUsersDir'}; |
|
my $DomainDir = $UserTopDir."/$domain"; |
|
my $ResourceFile = $DomainDir."/$namespace.db"; |
|
my %hash; |
|
if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) { |
|
if (scalar @_) { # Need to log the operation. |
|
my $logFh = IO::File->new(">>$DomainDir/$namespace.hist"); |
|
if($logFh) { |
|
my $TimeStamp = time; |
|
my ($loghead, $logtail) = @_; |
|
print $logFh "$loghead:$TimeStamp:$logtail\n"; |
|
} |
|
} |
|
return \%hash; # Return the tied hash. |
|
} |
|
else { |
|
return undef; # Tie failed. |
|
} |
|
} |
|
|
|
# |
|
# Ties a user's resource file to a hash. |
|
# If necessary, an appropriate history |
# log file entry is made as well. |
# log file entry is made as well. |
# This sub factors out common code from the subs that manipulate |
# This sub factors out common code from the subs that manipulate |
# the various gdbm files that keep keyword value pairs. |
# the various gdbm files that keep keyword value pairs. |
Line 179 sub isClient {
|
Line 228 sub isClient {
|
# hash to which the database is tied. It's up to the caller to untie. |
# hash to which the database is tied. It's up to the caller to untie. |
# undef if the has could not be tied. |
# undef if the has could not be tied. |
# |
# |
sub TieResourceHash { |
sub TieUserHash { |
my $domain = shift; |
my $domain = shift; |
my $user = shift; |
my $user = shift; |
my $namespace = shift; |
my $namespace = shift; |
my $how = shift; |
my $how = shift; |
|
|
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\W//g; # whitespace eliminated. |
$namespace=~s/\W//g; # whitespace eliminated. |
my $proname = propath($domain, $user); |
my $proname = propath($domain, $user); |
|
|
# If this is a namespace for which a history is kept, |
# If this is a namespace for which a history is kept, |
# make the history log entry: |
# make the history log entry: |
|
|
|
|
unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) { |
unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) { |
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
if($hfh) { |
if($hfh) { |
my $now = time; |
my $now = time; |
my $loghead = shift; |
my $loghead = shift; |
my $what = shift; |
my $what = shift; |
print $hfh "$loghead:$now:$what\n"; |
print $hfh "$loghead:$now:$what\n"; |
} |
} |
} |
} |
# Tie the database. |
# Tie the database. |
|
|
my %hash; |
my %hash; |
if(tie(%hash, 'GDBM_FILE', "$proname/$namespace.db", |
if(tie(%hash, 'GDBM_FILE', "$proname/$namespace.db", |
$how, 0640)) { |
$how, 0640)) { |
return \%hash; |
return \%hash; |
} |
} |
else { |
else { |
return undef; |
return undef; |
} |
} |
|
|
} |
} |
|
|
# |
# |
Line 676 sub AuthenticateHandler {
|
Line 725 sub AuthenticateHandler {
|
my $cmd = shift; |
my $cmd = shift; |
my $tail = shift; |
my $tail = shift; |
my $client = shift; |
my $client = shift; |
|
|
# Regenerate the full input line |
# Regenerate the full input line |
|
|
my $userinput = $cmd.":".$tail; |
my $userinput = $cmd.":".$tail; |
|
|
# udom - User's domain. |
# udom - User's domain. |
# uname - Username. |
# uname - Username. |
# upass - User's password. |
# upass - User's password. |
|
|
my ($udom,$uname,$upass)=split(/:/,$tail); |
my ($udom,$uname,$upass)=split(/:/,$tail); |
Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); |
Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); |
chomp($upass); |
chomp($upass); |
Line 1360 sub PutUserProfileEntry {
|
Line 1409 sub PutUserProfileEntry {
|
my $tail = shift; |
my $tail = shift; |
my $client = shift; |
my $client = shift; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(),"P",$what); |
&GDBM_WRCREAT(),"P",$what); |
if($hashref) { |
if($hashref) { |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hashref->{$key}=$value; |
$hashref->{$key}=$value; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
Reply( $client, "ok\n", $userinput); |
Reply( $client, "ok\n", $userinput); |
} else { |
} else { |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
"while attempting put\n", |
"while attempting put\n", |
$userinput); |
$userinput); |
} |
} |
} else { |
} else { |
Failure( $client, "error: ".($!)." tie(GDBM) Failed ". |
Failure( $client, "error: ".($!)." tie(GDBM) Failed ". |
"while attempting put\n", $userinput); |
"while attempting put\n", $userinput); |
} |
} |
} else { |
} else { |
Failure( $client, "refused\n", $userinput); |
Failure( $client, "refused\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0); |
RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0); |
|
|
Line 1415 sub IncrementUserValueHandler {
|
Line 1464 sub IncrementUserValueHandler {
|
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, |
my $hashref = TieUserHash($udom, $uname, |
$namespace, &GDBM_WRCREAT(), |
$namespace, &GDBM_WRCREAT(), |
"P",$what); |
"P",$what); |
if ($hashref) { |
if ($hashref) { |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
# We could check that we have a number... |
# We could check that we have a number... |
if (! defined($value) || $value eq '') { |
if (! defined($value) || $value eq '') { |
$value = 1; |
$value = 1; |
} |
} |
$hashref->{$key}+=$value; |
$hashref->{$key}+=$value; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
Reply( $client, "ok\n", $userinput); |
Reply( $client, "ok\n", $userinput); |
} else { |
} else { |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
"while attempting inc\n", $userinput); |
"while attempting inc\n", $userinput); |
} |
} |
} else { |
} else { |
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
"while attempting inc\n", $userinput); |
"while attempting inc\n", $userinput); |
} |
} |
} else { |
} else { |
Failure($client, "refused\n", $userinput); |
Failure($client, "refused\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
Line 1476 sub RolesPutHandler {
|
Line 1525 sub RolesPutHandler {
|
"what = ".$what); |
"what = ".$what); |
my $namespace='roles'; |
my $namespace='roles'; |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "P", |
&GDBM_WRCREAT(), "P", |
"$exedom:$exeuser:$what"); |
"$exedom:$exeuser:$what"); |
# |
# |
# Log the attempt to set a role. The {}'s here ensure that the file |
# Log the attempt to set a role. The {}'s here ensure that the file |
# handle is open for the minimal amount of time. Since the flush |
# handle is open for the minimal amount of time. Since the flush |
Line 1533 sub RolesDeleteHandler {
|
Line 1582 sub RolesDeleteHandler {
|
"what = ".$what); |
"what = ".$what); |
my $namespace='roles'; |
my $namespace='roles'; |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "D", |
&GDBM_WRCREAT(), "D", |
"$exedom:$exeuser:$what"); |
"$exedom:$exeuser:$what"); |
|
|
if ($hashref) { |
if ($hashref) { |
my @rolekeys=split(/\&/,$what); |
my @rolekeys=split(/\&/,$what); |
|
|
foreach my $key (@rolekeys) { |
foreach my $key (@rolekeys) { |
delete $hashref->{$key}; |
delete $hashref->{$key}; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
Reply($client, "ok\n", $userinput); |
Reply($client, "ok\n", $userinput); |
} else { |
} else { |
Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
"while attempting rolesdel\n", $userinput); |
"while attempting rolesdel\n", $userinput); |
} |
} |
} else { |
} else { |
Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
"while attempting rolesdel\n", $userinput); |
"while attempting rolesdel\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
Line 1585 sub GetProfileEntry {
|
Line 1634 sub GetProfileEntry {
|
|
|
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $qresult=''; |
my $qresult=''; |
|
|
for (my $i=0;$i<=$#queries;$i++) { |
for (my $i=0;$i<=$#queries;$i++) { |
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string. |
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string. |
} |
} |
Line 1640 sub GetProfileEntryEncrypted {
|
Line 1689 sub GetProfileEntryEncrypted {
|
|
|
my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput); |
my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput); |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
Line 1655 sub GetProfileEntryEncrypted {
|
Line 1704 sub GetProfileEntryEncrypted {
|
$qresult.=" "; |
$qresult.=" "; |
my $encqresult=''; |
my $encqresult=''; |
for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
$encqresult.= unpack("H16", $cipher->encrypt(substr($qresult, |
$encqresult.= unpack("H16", |
$encidx, |
$cipher->encrypt(substr($qresult, |
8))); |
$encidx, |
|
8))); |
} |
} |
Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); |
Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); |
} else { |
} else { |
Line 1703 sub DeleteProfileEntry {
|
Line 1753 sub DeleteProfileEntry {
|
|
|
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), |
&GDBM_WRCREAT(), |
"D",$what); |
"D",$what); |
if ($hashref) { |
if ($hashref) { |
Line 1747 sub GetProfileKeys {
|
Line 1797 sub GetProfileKeys {
|
|
|
my ($udom,$uname,$namespace)=split(/:/,$tail); |
my ($udom,$uname,$namespace)=split(/:/,$tail); |
my $qresult=''; |
my $qresult=''; |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
foreach my $key (keys %$hashref) { |
foreach my $key (keys %$hashref) { |
Line 1794 sub DumpProfileDatabase {
|
Line 1844 sub DumpProfileDatabase {
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$uname,$namespace) = split(/:/,$tail); |
my ($udom,$uname,$namespace) = split(/:/,$tail); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
# Structure of %data: |
# Structure of %data: |
Line 1802 sub DumpProfileDatabase {
|
Line 1852 sub DumpProfileDatabase {
|
# $data{$symb}->{'v.'.$parameter}=$version; |
# $data{$symb}->{'v.'.$parameter}=$version; |
# since $parameter will be unescaped, we do not |
# since $parameter will be unescaped, we do not |
# have to worry about silly parameter names... |
# have to worry about silly parameter names... |
|
|
my $qresult=''; |
my $qresult=''; |
my %data = (); # A hash of anonymous hashes.. |
my %data = (); # A hash of anonymous hashes.. |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
Line 1875 sub DumpWithRegexp {
|
Line 1925 sub DumpWithRegexp {
|
} else { |
} else { |
$regexp='.'; |
$regexp='.'; |
} |
} |
my $hashref =TieResourceHash($udom, $uname, $namespace, |
my $hashref =TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
my $qresult=''; |
my $qresult=''; |
Line 1935 sub StoreHandler {
|
Line 1985 sub StoreHandler {
|
|
|
chomp($what); |
chomp($what); |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "P", |
&GDBM_WRCREAT(), "P", |
"$rid:$what"); |
"$rid:$what"); |
if ($hashref) { |
if ($hashref) { |
Line 2214 sub PutCourseIdHandler {
|
Line 2264 sub PutCourseIdHandler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom, $what) = split(/:/, $tail); |
chomp($what); |
chomp($what); |
$udom=~s/\W//g; |
|
my $proname= |
|
"$perlvar{'lonUsersDir'}/$udom/nohist_courseids"; |
|
my $now=time; |
my $now=time; |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
|
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
|
if ($hashref) { |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hash{$key}=$value.':'.$now; |
$hashref->{$key}=$value.':'.$now; |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
Reply($client, "ok\n", $userinput); |
Reply($client, "ok\n", $userinput); |
} else { |
} else { |
Failure( $client, "error: ".($!+0) |
Failure( $client, "error: ".($!+0) |
Line 2282 sub DumpCourseIdHandler {
|
Line 2330 sub DumpCourseIdHandler {
|
} |
} |
unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
my $qresult=''; |
my $qresult=''; |
my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids"; |
|
my %hash; |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { |
if ($hashref) { |
while (my ($key,$value) = each(%hash)) { |
while (my ($key,$value) = each(%$hashref)) { |
my ($descr,$lasttime)=split(/\:/,$value); |
my ($descr,$lasttime)=split(/\:/,$value); |
if ($lasttime<$since) { |
if ($lasttime<$since) { |
next; |
next; |
Line 2299 sub DumpCourseIdHandler {
|
Line 2347 sub DumpCourseIdHandler {
|
} |
} |
} |
} |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
chop($qresult); |
chop($qresult); |
Reply($client, "$qresult\n", $userinput); |
Reply($client, "$qresult\n", $userinput); |
} else { |
} else { |
Line 2340 sub PutIdHandler {
|
Line 2388 sub PutIdHandler {
|
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom,$what)=split(/:/,$tail); |
chomp($what); |
chomp($what); |
$udom=~s/\W//g; |
|
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
|
my $now=time; |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname.hist")) { |
|
print $hfh "P:$now:$what\n"; |
|
} |
|
} |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
my $hashref = TieDomainHash($udom, "ids", &GDBM_WRCREAT(), |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
"P", $what); |
|
if ($hashref) { |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hash{$key}=$value; |
$hashref->{$key}=$value; |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
Reply($client, "ok\n", $userinput); |
Reply($client, "ok\n", $userinput); |
} else { |
} else { |
Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
Line 2394 sub GetIdHandler {
|
Line 2434 sub GetIdHandler {
|
my $cmd = shift; |
my $cmd = shift; |
my $tail = shift; |
my $tail = shift; |
my $client = shift; |
my $client = shift; |
|
|
my $userinput = "$client:$tail"; |
my $userinput = "$client:$tail"; |
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom,$what)=split(/:/,$tail); |
chomp($what); |
chomp($what); |
$udom=~s/\W//g; |
|
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
|
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $qresult=''; |
my $qresult=''; |
my %hash; |
my $hashref = TieDomainHash($udom, "ids", &GDBM_READER()); |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { |
if ($hashref) { |
for (my $i=0;$i<=$#queries;$i++) { |
for (my $i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hashref->{$queries[$i]}&"; |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
Reply($client, "$qresult\n", $userinput); |
Reply($client, "$qresult\n", $userinput); |
} else { |
} else { |
Line 2419 sub GetIdHandler {
|
Line 2457 sub GetIdHandler {
|
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
"while attempting idget\n",$userinput); |
"while attempting idget\n",$userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
|
|
Line 2487 sub TmpGetHandler {
|
Line 2525 sub TmpGetHandler {
|
my $id = shift; |
my $id = shift; |
my $client = shift; |
my $client = shift; |
my $userinput = "$cmd:$id"; |
my $userinput = "$cmd:$id"; |
|
|
chomp($id); |
chomp($id); |
$id=~s/\W/\_/g; |
$id=~s/\W/\_/g; |
my $store; |
my $store; |
Line 2522 sub TmpDelHandler {
|
Line 2560 sub TmpDelHandler {
|
my $cmd = shift; |
my $cmd = shift; |
my $id = shift; |
my $id = shift; |
my $client = shift; |
my $client = shift; |
|
|
my $userinput= "$cmd:$id"; |
my $userinput= "$cmd:$id"; |
|
|
chomp($id); |
chomp($id); |
$id=~s/\W/\_/g; |
$id=~s/\W/\_/g; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
Line 2534 sub TmpDelHandler {
|
Line 2572 sub TmpDelHandler {
|
Failure( $client, "error: ".($!+0)."Unlink tmp Failed ". |
Failure( $client, "error: ".($!+0)."Unlink tmp Failed ". |
"while attempting tmpdel\n", $userinput); |
"while attempting tmpdel\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
|
|
} |
} |
Line 3862 sub subsqlreply {
|
Line 3900 sub subsqlreply {
|
|
|
sub propath { |
sub propath { |
my ($udom,$uname)=@_; |
my ($udom,$uname)=@_; |
|
Debug("Propath:$udom:$uname"); |
$udom=~s/\W//g; |
$udom=~s/\W//g; |
$uname=~s/\W//g; |
$uname=~s/\W//g; |
|
Debug("Propath2:$udom:$uname"); |
my $subdir=$uname.'__'; |
my $subdir=$uname.'__'; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
|
Debug("Propath returning $proname"); |
return $proname; |
return $proname; |
} |
} |
|
|
Line 4124 sub PasswordPath {
|
Line 4165 sub PasswordPath {
|
my $user = shift; |
my $user = shift; |
|
|
my $path = &propath($domain, $user); |
my $path = &propath($domain, $user); |
my $path .= "/passwd"; |
$path .= "/passwd"; |
|
|
return $path; |
return $path; |
} |
} |
Line 4143 sub PasswordFilename {
|
Line 4184 sub PasswordFilename {
|
my $domain = shift; |
my $domain = shift; |
my $user = shift; |
my $user = shift; |
|
|
my $path = PasswordPath($domain, $user); |
Debug ("PasswordFilename called: dom = $domain user = $user"); |
|
|
|
my $path = PasswordPath($domain, $user); |
|
Debug("PasswordFilename got path: $path"); |
if(-e $path) { |
if(-e $path) { |
return $path; |
return $path; |
} else { |
} else { |