version 1.263, 2004/10/21 16:05:50
|
version 1.265, 2004/11/02 23:13:18
|
Line 46 use Authen::Krb5;
|
Line 46 use Authen::Krb5;
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use localauth; |
use localauth; |
use localenroll; |
use localenroll; |
|
use localstudentphoto; |
use File::Copy; |
use File::Copy; |
use LONCAPA::ConfigFileEdit; |
use LONCAPA::ConfigFileEdit; |
use LONCAPA::lonlocal; |
use LONCAPA::lonlocal; |
Line 1725 sub add_user_handler {
|
Line 1726 sub add_user_handler {
|
if (-e $passfilename) { |
if (-e $passfilename) { |
&Failure( $client, "already_exists\n", $userinput); |
&Failure( $client, "already_exists\n", $userinput); |
} else { |
} else { |
my @fpparts=split(/\//,$passfilename); |
|
my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2]; |
|
my $fperror=''; |
my $fperror=''; |
for (my $i=3;$i<= ($#fpparts-1);$i++) { |
if (!&mkpath($passfilename)) { |
$fpnow.='/'.$fpparts[$i]; |
$fperror="error: ".($!+0)." mkdir failed while attempting " |
unless (-e $fpnow) { |
."makeuser"; |
&logthis("mkdir $fpnow"); |
|
unless (mkdir($fpnow,0777)) { |
|
$fperror="error: ".($!+0)." mkdir failed while attempting " |
|
."makeuser"; |
|
} |
|
} |
|
} |
} |
unless ($fperror) { |
unless ($fperror) { |
my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); |
my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); |
Line 1967 sub fetch_user_file_handler {
|
Line 1960 sub fetch_user_file_handler {
|
# Note that any regular files in the way of this path are |
# Note that any regular files in the way of this path are |
# wiped out to deal with some earlier folly of mine. |
# wiped out to deal with some earlier folly of mine. |
|
|
my $path = $udir; |
if (!&mkpath($udir.'/')) { |
if ($ufile =~m|(.+)/([^/]+)$|) { |
&Failure($client, "unable_to_create\n", $userinput); |
my @parts=split('/',$1); |
|
foreach my $part (@parts) { |
|
$path .= '/'.$part; |
|
if( -f $path) { |
|
unlink($path); |
|
} |
|
if ((-e $path)!=1) { |
|
mkdir($path,0770); |
|
} |
|
} |
|
} |
} |
|
|
|
|
my $destname=$udir.'/'.$ufile; |
my $destname=$udir.'/'.$ufile; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
Line 2090 sub mkdir_user_file_handler {
|
Line 2072 sub mkdir_user_file_handler {
|
} else { |
} else { |
my $udir = &propath($udom,$uname); |
my $udir = &propath($udom,$uname); |
if (-e $udir) { |
if (-e $udir) { |
my $newdir=$udir.'/userfiles/'.$ufile; |
my $newdir=$udir.'/userfiles/'.$ufile.'/'; |
if (!-e $newdir) { |
if (!&mkpath($newdir)) { |
my @parts=split('/',$newdir); |
&Failure($client, "failed\n", "$cmd:$tail"); |
my $path; |
|
foreach my $part (@parts) { |
|
$path .= '/'.$part; |
|
if (!-e $path) { |
|
mkdir($path,0770); |
|
} |
|
} |
|
if (!-e $newdir) { |
|
&Failure($client, "failed\n", "$cmd:$tail"); |
|
} else { |
|
&Reply($client, "ok\n", "$cmd:$tail"); |
|
} |
|
} else { |
|
&Failure($client, "not_found\n", "$cmd:$tail"); |
|
} |
} |
|
&Reply($client, "ok\n", "$cmd:$tail"); |
} else { |
} else { |
&Failure($client, "not_home\n", "$cmd:$tail"); |
&Failure($client, "not_home\n", "$cmd:$tail"); |
} |
} |
Line 3824 sub get_institutional_code_format_handle
|
Line 3793 sub get_institutional_code_format_handle
|
|
|
return 1; |
return 1; |
} |
} |
|
®ister_handler("autoinstcodeformat", |
|
\&get_institutional_code_format_handler,0,1,0); |
|
|
®ister_handler("autoinstcodeformat", \&get_institutional_code_format_handler, |
|
0,1,0); |
|
|
|
# |
|
# |
|
# |
|
# |
|
# |
# |
|
# Gets a student's photo to exist (in the correct image type) in the user's |
|
# directory. |
|
# Formal Parameters: |
|
# $cmd - The command request that got us dispatched. |
|
# $tail - A colon separated set of words that will be split into: |
|
# $domain - student's domain |
|
# $uname - student username |
|
# $type - image type desired |
|
# $client - The socket open on the client. |
|
# Returns: |
|
# 1 - continue processing. |
|
sub student_photo_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my ($domain,$uname,$type) = split(/:/, $tail); |
|
|
|
my $path=&propath($domain,$uname). |
|
'/userfiles/internal/studentphoto.'.$type; |
|
if (-e $path) { |
|
&Reply($client,"ok\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
&mkpath($path); |
|
my $file=&localstudentphoto::fetch($domain,$uname); |
|
if (!$file) { |
|
&Failure($client,"unavailable\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
if (!-e $path) { &convert_photo($file,$path); } |
|
if (-e $path) { |
|
&Reply($client,"ok\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
&Failure($client,"unable_to_convert\n","$cmd:$tail"); |
|
return 1; |
|
} |
|
®ister_handler("studentphoto", \&student_photo_handler, 0, 1, 0); |
|
|
|
# mkpath makes all directories for a file, expects an absolute path with a |
|
# file or a trailing / if just a dir is passed |
|
# returns 1 on success 0 on failure |
|
sub mkpath { |
|
my ($file)=@_; |
|
my @parts=split(/\//,$file,-1); |
|
my $now=$parts[0].'/'.$parts[1].'/'.$parts[2]; |
|
for (my $i=3;$i<= ($#parts-1);$i++) { |
|
$now.='/'.$parts[$i]; |
|
if (!-e $now) { |
|
if (!mkdir($now,0770)) { return 0; } |
|
} |
|
} |
|
return 1; |
|
} |
|
|
#--------------------------------------------------------------- |
#--------------------------------------------------------------- |
# |
# |
# Getting, decoding and dispatching requests: |
# Getting, decoding and dispatching requests: |
Line 4887 sub manage_permissions
|
Line 4904 sub manage_permissions
|
# |
# |
sub password_path { |
sub password_path { |
my ($domain, $user) = @_; |
my ($domain, $user) = @_; |
|
return &propath($domain, $user).'/passwd'; |
|
|
my $path = &propath($domain, $user); |
|
$path .= "/passwd"; |
|
|
|
return $path; |
|
} |
} |
|
|
# Password Filename |
# Password Filename |
Line 5403 sub make_passwd_file {
|
Line 5415 sub make_passwd_file {
|
return $result; |
return $result; |
} |
} |
|
|
|
sub convert_photo { |
|
my ($start,$dest)=@_; |
|
system("convert $start $dest"); |
|
} |
|
|
sub sethost { |
sub sethost { |
my ($remotereq) = @_; |
my ($remotereq) = @_; |
my (undef,$hostid)=split(/:/,$remotereq); |
my (undef,$hostid)=split(/:/,$remotereq); |