new(">$passfilename");
if ($pf) {
print $pf "$umode:$npass\n";
+ &update_passwd_history($uname,$udom,$umode,$action);
} else {
$result = "pass_file_failed_error";
}
}
} elsif ($umode eq 'internal') {
- my $salt=time;
- $salt=substr($salt,6,2);
- my $ncpass=crypt($npass,$salt);
+ my $ncpass = &hash_passwd($udom,$npass);
{
&Debug("Creating internal auth");
my $pf = IO::File->new(">$passfilename");
if($pf) {
print $pf "internal:$ncpass\n";
+ &update_passwd_history($uname,$udom,$umode,$action);
} else {
$result = "pass_file_failed_error";
}
@@ -7370,61 +8227,14 @@ sub make_passwd_file {
my $pf = IO::File->new(">$passfilename");
if($pf) {
print $pf "localauth:$npass\n";
+ &update_passwd_history($uname,$udom,$umode,$action);
} else {
$result = "pass_file_failed_error";
}
}
} elsif ($umode eq 'unix') {
- {
- #
- # Don't allow the creation of privileged accounts!!! that would
- # be real bad!!!
- #
- my $uid = getpwnam($uname);
- if((defined $uid) && ($uid == 0)) {
- &logthis(">>>Attempt to create privileged account blocked");
- return "no_priv_account_error\n";
- }
-
- my $execpath ="$perlvar{'lonDaemons'}/"."lcuseradd";
-
- my $lc_error_file = $execdir."/tmp/lcuseradd".$$.".status";
- {
- &Debug("Executing external: ".$execpath);
- &Debug("user = ".$uname.", Password =". $npass);
- my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
- print $se "$uname\n";
- print $se "$udom\n";
- print $se "$npass\n";
- print $se "$npass\n";
- print $se "$lc_error_file\n"; # Status -> unique file.
- }
- if (-r $lc_error_file) {
- &Debug("Opening error file: $lc_error_file");
- my $error = IO::File->new("< $lc_error_file");
- my $useraddok = <$error>;
- $error->close;
- unlink($lc_error_file);
-
- chomp $useraddok;
-
- if($useraddok > 0) {
- my $error_text = &lcuseraddstrerror($useraddok);
- &logthis("Failed lcuseradd: $error_text");
- $result = "lcuseradd_failed:$error_text";
- } else {
- my $pf = IO::File->new(">$passfilename");
- if($pf) {
- print $pf "unix:\n";
- } else {
- $result = "pass_file_failed_error";
- }
- }
- } else {
- &Debug("Could not locate lcuseradd error: $lc_error_file");
- $result="bug_lcuseradd_no_output_file";
- }
- }
+ &logthis(">>>Attempt to create unix account blocked -- unix auth not available for new users.");
+ $result="no_new_unix_accounts";
} elsif ($umode eq 'none') {
{
my $pf = IO::File->new("> $passfilename");
@@ -7488,235 +8298,19 @@ sub get_usersession_config {
return;
}
-#
-# releasereqd_check() will determine if a LON-CAPA version (defined in the
-# $major,$minor args passed) is not too old to allow use of a role in a
-# course ($cnum,$cdom args passed), if at least one of the following applies:
-# (a) the course is a Community, (b) the course's home server is *not* the
-# current server, or (c) cached course information is not stale.
-#
-# For the case where none of these apply, the course is added to the
-# $homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
-# The $homecourse hash ref is for courses for which the current server is the
-# home server. LON-CAPA version requirements are checked elsewhere for the
-# items in $homecourse.
-#
-
-sub releasereqd_check {
- my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
- my $home = &Apache::lonnet::homeserver($cnum,$cdom);
- return if ($home eq 'no_host');
- my ($reqdmajor,$reqdminor,$displayrole);
- if ($cnum =~ /$LONCAPA::match_community/) {
- if ($major eq '' && $minor eq '') {
- return unless ((ref($ids) eq 'ARRAY') &&
- (grep(/^\Q$home\E$/,@{$ids})));
- } else {
- $reqdmajor = 2;
- $reqdminor = 9;
- return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
- }
- }
- my $hashid = $cdom.':'.$cnum;
- my ($courseinfo,$cached) =
- &Apache::lonnet::is_cached_new('courseinfo',$hashid);
+sub get_usersearch_config {
+ my ($dom,$name) = @_;
+ my ($usersearchconf,$cached)=&Apache::lonnet::is_cached_new($name,$dom);
if (defined($cached)) {
- if (ref($courseinfo) eq 'HASH') {
- if (exists($courseinfo->{'releaserequired'})) {
- my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
- return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
- }
- }
- } else {
- if (ref($ids) eq 'ARRAY') {
- if (grep(/^\Q$home\E$/,@{$ids})) {
- if (ref($homecourses) eq 'HASH') {
- if (ref($homecourses->{$cdom}) eq 'HASH') {
- if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
- if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
- push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
- } else {
- $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
- }
- } else {
- $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
- }
- } else {
- $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
- }
- }
- return;
- }
- }
- my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
- if (ref($courseinfo) eq 'HASH') {
- if (exists($courseinfo->{'releaserequired'})) {
- my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
- return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
- }
- } else {
- return;
- }
- }
- return 1;
-}
-
-#
-# get_courseinfo_hash() is used to retrieve course information from the db
-# file: nohist_courseids.db for a course for which the current server is *not*
-# the home server.
-#
-# A hash of a hash will be retrieved. The outer hash contains a single key --
-# courseID -- for the course for which the data are being requested.
-# The contents of the inner hash, for that single item in the outer hash
-# are returned (and cached in memcache for 10 minutes).
-#
-
-sub get_courseinfo_hash {
- my ($cnum,$cdom,$home) = @_;
- my %info;
- eval {
- local($SIG{ALRM}) = sub { die "timeout\n"; };
- local($SIG{__DIE__})='DEFAULT';
- alarm(3);
- %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
- alarm(0);
- };
- if ($@) {
- if ($@ eq "timeout\n") {
- &logthis("WARNING courseiddump for $cnum:$cdom from $home timedout");
- } else {
- &logthis("WARNING unexpected error during eval of call for courseiddump from $home");
- }
+ return $usersearchconf;
} else {
- if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
- my $hashid = $cdom.':'.$cnum;
- return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
- }
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['directorysrch'],$dom);
+ &Apache::lonnet::do_cache_new($name,$dom,$domconfig{'directorysrch'},3600);
+ return $domconfig{'directorysrch'};
}
return;
}
-#
-# check_homecourses() will retrieve course information for those courses which
-# are keys of the $homecourses hash ref (first arg). The nohist_courseids.db
-# GDBM file is tied and course information for each course retrieved. Last
-# visit (lasttime key) is also retrieved for each, and cached values updated
-# for any courses last visited less than 24 hours ago. Cached values are also
-# updated for any courses included in the $homecourses hash ref.
-#
-# The reason for the 24 hours constraint is that the cron entry in
-# /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes
-# cached course information to be updated nightly for courses with activity
-# within the past 24 hours.
-#
-# Role information for the user (included in a ref to an array of hashes as the
-# value for each key in $homecourses) is appended to the result returned by the
-# routine, which will in turn be appended to the string returned to the client
-# hosting the user's session.
-#
-
-sub check_homecourses {
- my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
- my ($result,%addtocache);
- my $yesterday = time - 24*3600;
- if (ref($homecourses) eq 'HASH') {
- my (%okcourses,%courseinfo,%recent);
- foreach my $domain (keys(%{$homecourses})) {
- my $hashref =
- &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
- if (ref($hashref) eq 'HASH') {
- while (my ($key,$value) = each(%$hashref)) {
- my $unesc_key = &unescape($key);
- if ($unesc_key =~ /^lasttime:(\w+)$/) {
- my $cid = $1;
- $cid =~ s/_/:/;
- if ($value > $yesterday ) {
- $recent{$cid} = 1;
- }
- next;
- }
- my $items = &Apache::lonnet::thaw_unescape($value);
- if (ref($items) eq 'HASH') {
- my ($cdom,$cnum) = split(/_/,$unesc_key);
- my $hashid = $cdom.':'.$cnum;
- $courseinfo{$hashid} = $items;
- if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
- my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
- if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
- $okcourses{$hashid} = 1;
- }
- }
- }
- }
- unless (&untie_domain_hash($hashref)) {
- &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
- }
- } else {
- &logthis("Failed to tie hash for nohist_courseids.db for $domain");
- }
- }
- foreach my $hashid (keys(%recent)) {
- my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
- unless ($cached) {
- &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
- }
- }
- foreach my $cdom (keys(%{$homecourses})) {
- if (ref($homecourses->{$cdom}) eq 'HASH') {
- foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
- my $hashid = $cdom.':'.$cnum;
- next if ($recent{$hashid});
- &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
- }
- }
- }
- foreach my $hashid (keys(%okcourses)) {
- my ($cdom,$cnum) = split(/:/,$hashid);
- if ((ref($homecourses->{$cdom}) eq 'HASH') &&
- (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
- foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
- if (ref($role) eq 'HASH') {
- while (my ($key,$value) = each(%{$role})) {
- if ($regexp eq '.') {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $result.=$key.'='.$value.'&';
- } else {
- my $unescapeKey = &unescape($key);
- if (eval('$unescapeKey=~/$regexp/')) {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $result.="$key=$value&";
- }
- }
- }
- }
- }
- }
- }
- }
- return $result;
-}
-
-#
-# useable_role() will compare the LON-CAPA version required by a course with
-# the version available on the client server. If the client server's version
-# is compatible, 1 will be returned.
-#
-
-sub useable_role {
- my ($reqdmajor,$reqdminor,$major,$minor) = @_;
- if ($reqdmajor ne '' && $reqdminor ne '') {
- return if (($major eq '' && $minor eq '') ||
- ($major < $reqdmajor) ||
- (($major == $reqdmajor) && ($minor < $reqdminor)));
- }
- return 1;
-}
-
sub distro_and_arch {
return $dist.':'.$arch;
}
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.