|
version 1.489.2.10, 2013/12/13 17:30:30
|
version 1.489.2.17, 2015/03/12 00:37:30
|
|
Line 621 sub ConfigFileFromSelector {
|
Line 621 sub ConfigFileFromSelector {
|
| # String to send to client ("ok" or "refused" if bad file). |
# String to send to client ("ok" or "refused" if bad file). |
| # |
# |
| sub PushFile { |
sub PushFile { |
| my $request = shift; |
my $request = shift; |
| my ($command, $filename, $contents) = split(":", $request, 3); |
my ($command, $filename, $contents) = split(":", $request, 3); |
| &Debug("PushFile"); |
&Debug("PushFile"); |
| |
|
|
Line 651 sub PushFile {
|
Line 651 sub PushFile {
|
| |
|
| if($filename eq "host") { |
if($filename eq "host") { |
| $contents = AdjustHostContents($contents); |
$contents = AdjustHostContents($contents); |
| |
} elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') { |
| |
if ($contents eq '') { |
| |
&logthis('<font color="red"> Pushfile: unable to install ' |
| |
.$tablefile." - no data received from push. </font>"); |
| |
return 'error: push had no data'; |
| |
} |
| |
if (&Apache::lonnet::get_host_ip($clientname)) { |
| |
my $clienthost = &Apache::lonnet::hostname($clientname); |
| |
if ($managers{$clientip} eq $clientname) { |
| |
my $clientprotocol = $Apache::lonnet::protocol{$clientname}; |
| |
$clientprotocol = 'http' if ($clientprotocol ne 'https'); |
| |
my $url = '/adm/'.$filename; |
| |
$url =~ s{_}{/}; |
| |
my $ua=new LWP::UserAgent; |
| |
$ua->timeout(60); |
| |
my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url"); |
| |
my $response=$ua->request($request); |
| |
if ($response->is_error()) { |
| |
&logthis('<font color="red"> Pushfile: unable to install ' |
| |
.$tablefile." - error attempting to pull data. </font>"); |
| |
return 'error: pull failed'; |
| |
} else { |
| |
my $result = $response->content; |
| |
chomp($result); |
| |
unless ($result eq $contents) { |
| |
&logthis('<font color="red"> Pushfile: unable to install ' |
| |
.$tablefile." - pushed data and pulled data differ. </font>"); |
| |
my $pushleng = length($contents); |
| |
my $pullleng = length($result); |
| |
if ($pushleng != $pullleng) { |
| |
return "error: $pushleng vs $pullleng bytes"; |
| |
} else { |
| |
return "error: mismatch push and pull"; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| } |
} |
| |
|
| # Install the new file: |
# Install the new file: |
|
Line 2774 sub newput_user_profile_entry {
|
Line 2812 sub newput_user_profile_entry {
|
| foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
| my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
| if (exists($hashref->{$key})) { |
if (exists($hashref->{$key})) { |
| |
if (!&untie_user_hash($hashref)) { |
| |
&logthis("error: ".($!+0)." untie (GDBM) failed ". |
| |
"while attempting newput - early out as key exists"); |
| |
} |
| &Failure($client, "key_exists: ".$key."\n",$userinput); |
&Failure($client, "key_exists: ".$key."\n",$userinput); |
| return 1; |
return 1; |
| } |
} |
|
Line 3277 sub dump_with_regexp {
|
Line 3319 sub dump_with_regexp {
|
| # namespace - Name of the database being modified |
# namespace - Name of the database being modified |
| # rid - Resource keyword to modify. |
# rid - Resource keyword to modify. |
| # what - new value associated with rid. |
# what - new value associated with rid. |
| |
# laststore - (optional) version=timestamp |
| |
# for most recent transaction for rid |
| |
# in namespace, when cstore was called |
| # |
# |
| # $client - Socket open on the client. |
# $client - Socket open on the client. |
| # |
# |
|
Line 3285 sub dump_with_regexp {
|
Line 3330 sub dump_with_regexp {
|
| # 1 (keep on processing). |
# 1 (keep on processing). |
| # Side-Effects: |
# Side-Effects: |
| # Writes to the client |
# Writes to the client |
| |
# Successful storage will cause either 'ok', or, if $laststore was included |
| |
# in the tail of the request, and the version number for the last transaction |
| |
# is larger than the version in $laststore, delay:$numtrans , where $numtrans |
| |
# is the number of store evevnts recorded for rid in namespace since |
| |
# lonnet::store() was called by the client. |
| |
# |
| sub store_handler { |
sub store_handler { |
| my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
| |
|
| my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
| |
|
| my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail); |
chomp($tail); |
| |
my ($udom,$uname,$namespace,$rid,$what,$laststore) =split(/:/,$tail); |
| if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
| |
|
| chomp($what); |
|
| my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
| my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
| &GDBM_WRCREAT(), "S", |
&GDBM_WRCREAT(), "S", |
| "$rid:$what"); |
"$rid:$what"); |
| if ($hashref) { |
if ($hashref) { |
| my $now = time; |
my $now = time; |
| my @previouskeys=split(/&/,$hashref->{"keys:$rid"}); |
my $numtrans; |
| my $key; |
if ($laststore) { |
| |
my ($previousversion,$previoustime) = split(/\=/,$laststore); |
| |
my ($lastversion,$lasttime) = (0,0); |
| |
$lastversion = $hashref->{"version:$rid"}; |
| |
if ($lastversion) { |
| |
$lasttime = $hashref->{"$lastversion:$rid:timestamp"}; |
| |
} |
| |
if (($previousversion) && ($previousversion !~ /\D/)) { |
| |
if (($lastversion > $previousversion) && ($lasttime >= $previoustime)) { |
| |
$numtrans = $lastversion - $previousversion; |
| |
} |
| |
} elsif ($lastversion) { |
| |
$numtrans = $lastversion; |
| |
} |
| |
if ($numtrans) { |
| |
$numtrans =~ s/D//g; |
| |
} |
| |
} |
| |
|
| $hashref->{"version:$rid"}++; |
$hashref->{"version:$rid"}++; |
| my $version=$hashref->{"version:$rid"}; |
my $version=$hashref->{"version:$rid"}; |
| my $allkeys=''; |
my $allkeys=''; |
|
Line 3314 sub store_handler {
|
Line 3383 sub store_handler {
|
| $allkeys.='timestamp'; |
$allkeys.='timestamp'; |
| $hashref->{"$version:keys:$rid"}=$allkeys; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
| if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
| &Reply($client, "ok\n", $userinput); |
my $msg = 'ok'; |
| |
if ($numtrans) { |
| |
$msg = 'delay:'.$numtrans; |
| |
} |
| |
&Reply($client, "$msg\n", $userinput); |
| } else { |
} else { |
| &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
| "while attempting store\n", $userinput); |
"while attempting store\n", $userinput); |
|
Line 3830 sub put_course_id_hash_handler {
|
Line 3903 sub put_course_id_hash_handler {
|
| # creationcontext - include courses created in specified context |
# creationcontext - include courses created in specified context |
| # |
# |
| # domcloner - flag to indicate if user can create CCs in course's domain. |
# domcloner - flag to indicate if user can create CCs in course's domain. |
| # If so, ability to clone course is automatic. |
# If so, ability to clone course is automatic. |
| |
# hasuniquecode - filter by courses for which a six character unique code has |
| |
# been set. |
| # |
# |
| # $client - The socket open on the client. |
# $client - The socket open on the client. |
| # Returns: |
# Returns: |
|
Line 3844 sub dump_course_id_handler {
|
Line 3919 sub dump_course_id_handler {
|
| my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
| $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden, |
$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden, |
| $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter, |
$caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter, |
| $creationcontext,$domcloner) =split(/:/,$tail); |
$creationcontext,$domcloner,$hasuniquecode) =split(/:/,$tail); |
| my $now = time; |
my $now = time; |
| my ($cloneruname,$clonerudom,%cc_clone); |
my ($cloneruname,$clonerudom,%cc_clone); |
| if (defined($description)) { |
if (defined($description)) { |
|
Line 3917 sub dump_course_id_handler {
|
Line 3992 sub dump_course_id_handler {
|
| } else { |
} else { |
| $creationcontext = '.'; |
$creationcontext = '.'; |
| } |
} |
| |
unless ($hasuniquecode) { |
| |
$hasuniquecode = '.'; |
| |
} |
| my $unpack = 1; |
my $unpack = 1; |
| if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && |
if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && |
| $typefilter eq '.') { |
$typefilter eq '.') { |
|
Line 4005 sub dump_course_id_handler {
|
Line 4083 sub dump_course_id_handler {
|
| $selfenroll_end = $items->{'selfenroll_end_date'}; |
$selfenroll_end = $items->{'selfenroll_end_date'}; |
| $created = $items->{'created'}; |
$created = $items->{'created'}; |
| $context = $items->{'context'}; |
$context = $items->{'context'}; |
| |
if ($hasuniquecode ne '.') { |
| |
next unless ($items->{'uniquecode'}); |
| |
} |
| if ($selfenrollonly) { |
if ($selfenrollonly) { |
| next if (!$selfenroll_types); |
next if (!$selfenroll_types); |
| if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) { |
if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) { |
|
Line 5237 sub crsreq_checks_handler {
|
Line 5318 sub crsreq_checks_handler {
|
| my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
| my $dom = $tail; |
my $dom = $tail; |
| my $result; |
my $result; |
| my @reqtypes = ('official','unofficial','community'); |
my @reqtypes = ('official','unofficial','community','textbook'); |
| eval { |
eval { |
| local($SIG{__DIE__})='DEFAULT'; |
local($SIG{__DIE__})='DEFAULT'; |
| my %validations; |
my %validations; |
|
Line 5264 sub crsreq_checks_handler {
|
Line 5345 sub crsreq_checks_handler {
|
| sub validate_crsreq_handler { |
sub validate_crsreq_handler { |
| my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
| my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
| my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail); |
my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$customdata) = split(/:/, $tail); |
| $instcode = &unescape($instcode); |
$instcode = &unescape($instcode); |
| $owner = &unescape($owner); |
$owner = &unescape($owner); |
| $crstype = &unescape($crstype); |
$crstype = &unescape($crstype); |
| $inststatuslist = &unescape($inststatuslist); |
$inststatuslist = &unescape($inststatuslist); |
| $instcode = &unescape($instcode); |
$instcode = &unescape($instcode); |
| $instseclist = &unescape($instseclist); |
$instseclist = &unescape($instseclist); |
| |
my $custominfo = &Apache::lonnet::thaw_unescape($customdata); |
| my $outcome; |
my $outcome; |
| eval { |
eval { |
| local($SIG{__DIE__})='DEFAULT'; |
local($SIG{__DIE__})='DEFAULT'; |
| $outcome = &localenroll::validate_crsreq($dom,$owner,$crstype, |
$outcome = &localenroll::validate_crsreq($dom,$owner,$crstype, |
| $inststatuslist,$instcode, |
$inststatuslist,$instcode, |
| $instseclist); |
$instseclist,$custominfo); |
| }; |
}; |
| if (!$@) { |
if (!$@) { |
| &Reply($client, \$outcome, $userinput); |
&Reply($client, \$outcome, $userinput); |
|
Line 5287 sub validate_crsreq_handler {
|
Line 5369 sub validate_crsreq_handler {
|
| } |
} |
| ®ister_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0); |
®ister_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0); |
| |
|
| |
sub crsreq_update_handler { |
| |
my ($cmd, $tail, $client) = @_; |
| |
my $userinput = "$cmd:$tail"; |
| |
my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,$code, |
| |
$accessstart,$accessend,$infohashref) = |
| |
split(/:/, $tail); |
| |
$crstype = &unescape($crstype); |
| |
$action = &unescape($action); |
| |
$ownername = &unescape($ownername); |
| |
$ownerdomain = &unescape($ownerdomain); |
| |
$fullname = &unescape($fullname); |
| |
$title = &unescape($title); |
| |
$code = &unescape($code); |
| |
$accessstart = &unescape($accessstart); |
| |
$accessend = &unescape($accessend); |
| |
my $incoming = &Apache::lonnet::thaw_unescape($infohashref); |
| |
my ($result,$outcome); |
| |
eval { |
| |
local($SIG{__DIE__})='DEFAULT'; |
| |
my %rtnhash; |
| |
$outcome = &localenroll::crsreq_updates($cdom,$cnum,$crstype,$action, |
| |
$ownername,$ownerdomain,$fullname, |
| |
$title,$code,$accessstart,$accessend, |
| |
$incoming,\%rtnhash); |
| |
if ($outcome eq 'ok') { |
| |
my @posskeys = qw(createdweb createdmsg queuedweb queuedmsg formitems reviewweb); |
| |
foreach my $key (keys(%rtnhash)) { |
| |
if (grep(/^\Q$key\E/,@posskeys)) { |
| |
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&'; |
| |
} |
| |
} |
| |
$result =~ s/\&$//; |
| |
} |
| |
}; |
| |
if (!$@) { |
| |
if ($outcome eq 'ok') { |
| |
&Reply($client, \$result, $userinput); |
| |
} else { |
| |
&Reply($client, "format_error\n", $userinput); |
| |
} |
| |
} else { |
| |
&Failure($client,"unknown_cmd\n",$userinput); |
| |
} |
| |
return 1; |
| |
} |
| |
®ister_handler("autocrsrequpdate", \&crsreq_update_handler, 0, 1, 0); |
| |
|
| # |
# |
| # Read and retrieve institutional code format (for support form). |
# Read and retrieve institutional code format (for support form). |
| # Formal Parameters: |
# Formal Parameters: |
|
Line 6479 sub make_new_child {
|
Line 6608 sub make_new_child {
|
| # my $tmpsnum=0; # Now global |
# my $tmpsnum=0; # Now global |
| #---------------------------------------------------- kerberos 5 initialization |
#---------------------------------------------------- kerberos 5 initialization |
| &Authen::Krb5::init_context(); |
&Authen::Krb5::init_context(); |
| unless (($dist eq 'fedora5') || ($dist eq 'fedora4') || |
|
| ($dist eq 'fedora6') || ($dist eq 'suse9.3') || |
my $no_ets; |
| ($dist eq 'suse12.2') || ($dist eq 'suse12.3') || |
if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) { |
| ($dist eq 'suse13.1')) { |
if ($1 >= 7) { |
| &Authen::Krb5::init_ets(); |
$no_ets = 1; |
| } |
} |
| |
} elsif ($dist =~ /^suse(\d+\.\d+)$/) { |
| |
if (($1 eq '9.3') || ($1 >= 12.2)) { |
| |
$no_ets = 1; |
| |
} |
| |
} elsif ($dist =~ /^sles(\d+)$/) { |
| |
if ($1 > 11) { |
| |
$no_ets = 1; |
| |
} |
| |
} elsif ($dist =~ /^fedora(\d+)$/) { |
| |
if ($1 < 7) { |
| |
$no_ets = 1; |
| |
} |
| |
} |
| |
unless ($no_ets) { |
| |
&Authen::Krb5::init_ets(); |
| |
} |
| |
|
| &status('Accepted connection'); |
&status('Accepted connection'); |
| # ============================================================================= |
# ============================================================================= |
![[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