version 1.318.2.6, 2006/03/04 04:27:38
|
version 1.329, 2006/05/18 17:55:49
|
Line 31
|
Line 31
|
|
|
use strict; |
use strict; |
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
|
use LONCAPA; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
|
use IO::Socket; |
use IO::Socket; |
use IO::File; |
use IO::File; |
#use Apache::File; |
#use Apache::File; |
use Symbol; |
|
use POSIX; |
use POSIX; |
use Crypt::IDEA; |
use Crypt::IDEA; |
use LWP::UserAgent(); |
use LWP::UserAgent(); |
Line 53 use LONCAPA::ConfigFileEdit;
|
Line 53 use LONCAPA::ConfigFileEdit;
|
use LONCAPA::lonlocal; |
use LONCAPA::lonlocal; |
use LONCAPA::lonssl; |
use LONCAPA::lonssl; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
use Symbol; |
|
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
Line 1049 sub _do_hash_untie {
|
Line 1048 sub _do_hash_untie {
|
|
|
sub _locking_hash_tie { |
sub _locking_hash_tie { |
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
|
my $lock_type=LOCK_SH; |
|
# Are we reading or writing? |
|
if ($how eq &GDBM_READER()) { |
|
# We are reading |
|
if (!open($sym,"$file_prefix.db.lock")) { |
|
# We don't have a lock file. This could mean |
|
# - that there is no such db-file |
|
# - that it does not have a lock file yet |
|
if ((! -e "$file_prefix.db") && (! -e "$file_prefix.db.gz")) { |
|
# No such file. Forget it. |
|
$! = 2; |
|
return undef; |
|
} |
|
# Apparently just no lock file yet. Make one |
|
open($sym,">>$file_prefix.db.lock"); |
|
} |
|
# Do a shared lock |
|
if (!&flock_sym(LOCK_SH)) { return undef; } |
|
# If this is compressed, we will actually need an exclusive lock |
|
if (-e "$file_prefix.db.gz") { |
|
if (!&flock_sym(LOCK_EX)) { return undef; } |
|
} |
|
} elsif ($how eq &GDBM_WRCREAT()) { |
|
# We are writing |
|
open($sym,">>$file_prefix.db.lock"); |
|
# Writing needs exclusive lock |
|
if (!&flock_sym(LOCK_EX)) { return undef; } |
|
} else { |
|
&logthis("Unknown method $how for $file_prefix"); |
|
die(); |
|
} |
|
# The file is ours! |
|
# If it is archived, un-archive it now |
|
if (-e "$file_prefix.db.gz") { |
|
system("gunzip $file_prefix.db.gz"); |
|
if (-e "$file_prefix.hist.gz") { |
|
system("gunzip $file_prefix.hist.gz"); |
|
} |
|
} |
|
# Change access mode to non-blocking |
|
$how=$how|&GDBM_NOLOCK(); |
|
# Go ahead and tie the hash |
|
return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); |
|
} |
|
|
my ($lock); |
sub flock_sym { |
|
my ($lock_type)=@_; |
if ($how eq &GDBM_READER()) { |
|
$lock=LOCK_SH; |
|
$how=$how|&GDBM_NOLOCK(); |
|
#if the db doesn't exist we can't read from it |
|
if (! -e "$file_prefix.db") { |
|
$! = 2; |
|
return undef; |
|
} |
|
} elsif ($how eq &GDBM_WRCREAT()) { |
|
$lock=LOCK_EX; |
|
$how=$how|&GDBM_NOLOCK(); |
|
if (! -e "$file_prefix.db") { |
|
# doesn't exist but we need it to in order to successfully |
|
# lock it so bring it into existance |
|
open(TOUCH,">>$file_prefix.db"); |
|
close(TOUCH); |
|
} |
|
} else { |
|
&logthis("Unknown method $how for $file_prefix"); |
|
die(); |
|
} |
|
|
|
$sym=&Symbol::gensym(); |
|
open($sym,"$file_prefix.db"); |
|
my $failed=0; |
my $failed=0; |
eval { |
eval { |
local $SIG{__DIE__}='DEFAULT'; |
local $SIG{__DIE__}='DEFAULT'; |
local $SIG{ALRM}=sub { |
local $SIG{ALRM}=sub { |
$failed=1; |
$failed=1; |
die("failed lock"); |
die("failed lock"); |
}; |
}; |
alarm($lond_max_wait_time); |
alarm($lond_max_wait_time); |
flock($sym,$lock); |
flock($sym,$lock_type); |
alarm(0); |
alarm(0); |
}; |
}; |
if ($failed) { |
if ($failed) { |
$! = 100; # throwing error # 100 |
$! = 100; # throwing error # 100 |
return undef; |
return undef; |
|
} else { |
|
return 1; |
} |
} |
return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); |
|
} |
} |
|
|
sub _locking_hash_untie { |
sub _locking_hash_untie { |
Line 2915 sub dump_profile_database {
|
Line 2935 sub dump_profile_database {
|
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
my ($v,$symb,$param) = split(/:/,$key); |
my ($v,$symb,$param) = split(/:/,$key); |
next if ($v eq 'version' || $symb eq 'keys'); |
next if ($v eq 'version' || $symb eq 'keys'); |
# making old style store entries '$ver:$symb:$key = $value' |
next if (exists($data{$symb}) && |
# look like new '$ver:compressed:$symb = "$key=$value"' |
exists($data{$symb}->{$param}) && |
if ($symb eq 'compressed') { |
$data{$symb}->{'v.'.$param} > $v); |
$symb = $param; |
$data{$symb}->{$param}=$value; |
} else { |
$data{$symb}->{'v.'.$param}=$v; |
$value = $param.'='.$value; |
|
} |
|
foreach my $pair (split(/\&/,$value)) { |
|
my ($param,$value)=split(/=/,$pair); |
|
next if (exists($data{$symb}) && |
|
exists($data{$symb}->{$param}) && |
|
$data{$symb}->{'v.'.$param} > $v); |
|
$data{$symb}->{$param}=$value; |
|
$data{$symb}->{'v.'.$param}=$v; |
|
} |
|
} |
} |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
while (my ($symb,$param_hash) = each(%data)) { |
while (my ($symb,$param_hash) = each(%data)) { |
Line 3078 sub store_handler {
|
Line 3088 sub store_handler {
|
my $version=$hashref->{"version:$rid"}; |
my $version=$hashref->{"version:$rid"}; |
my $allkeys=''; |
my $allkeys=''; |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$allkeys.=$key.':'; |
$allkeys.=$key.':'; |
|
$hashref->{"$version:$rid:$key"}=$value; |
} |
} |
$hashref->{"$version:compressed:$rid"}=$what."\×tamp=$now"; |
$hashref->{"$version:$rid:timestamp"}=$now; |
$allkeys.='timestamp'; |
$allkeys.='timestamp'; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
Line 3102 sub store_handler {
|
Line 3113 sub store_handler {
|
} |
} |
®ister_handler("store", \&store_handler, 0, 1, 0); |
®ister_handler("store", \&store_handler, 0, 1, 0); |
|
|
|
# Modify a set of key=value pairs associated with a versioned name. |
|
# |
|
# Parameters: |
|
# $cmd - Request command keyword. |
|
# $tail - Tail of the request. This is a colon |
|
# separated list containing: |
|
# domain/user - User and authentication domain. |
|
# namespace - Name of the database being modified |
|
# rid - Resource keyword to modify. |
|
# v - Version item to modify |
|
# what - new value associated with rid. |
|
# |
|
# $client - Socket open on the client. |
|
# |
|
# |
|
# Returns: |
|
# 1 (keep on processing). |
|
# Side-Effects: |
|
# Writes to the client |
sub putstore_handler { |
sub putstore_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
|
|
Line 3112 sub putstore_handler {
|
Line 3142 sub putstore_handler {
|
|
|
chomp($what); |
chomp($what); |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "C", |
&GDBM_WRCREAT(), "M", |
"$rid:$what"); |
"$rid:$v:$what"); |
if ($hashref) { |
if ($hashref) { |
my $now = time; |
my $now = time; |
my %data = &hash_extract($what); |
my %data = &hash_extract($what); |
my @allkeys; |
my @allkeys; |
if (exists($hashref->{"$v:compressed:$rid"})) { |
while (my($key,$value) = each(%data)) { |
my %current = &hash_extract($hashref->{"$v:compressed:$rid"}); |
push(@allkeys,$key); |
while (my($key,$value) = each(%data)) { |
$hashref->{"$v:$rid:$key"} = $value; |
push(@allkeys,$key); |
|
$current{$key} = $value; |
|
} |
|
$hashref->{"$v:compressed:$rid"}= &hash_to_str(\%current); |
|
} else { |
|
while (my($key,$value) = each(%data)) { |
|
push(@allkeys,$key); |
|
$hashref->{"$v:$rid:$key"} = $value; |
|
} |
|
} |
} |
my $allkeys = join(':',@allkeys); |
my $allkeys = join(':',@allkeys); |
$hashref->{"$v:keys:$rid"}=$allkeys; |
$hashref->{"$v:keys:$rid"}=$allkeys; |
Line 3216 sub restore_handler {
|
Line 3237 sub restore_handler {
|
my @keys=split(/:/,$vkeys); |
my @keys=split(/:/,$vkeys); |
my $key; |
my $key; |
$qresult.="$scope:keys=$vkeys&"; |
$qresult.="$scope:keys=$vkeys&"; |
if (exists($hashref->{"$scope:compressed:$rid"})) { |
foreach $key (@keys) { |
foreach my $pair (split(/\&/,$hashref->{"$scope:compressed:$rid"})) { |
$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; |
my ($key,$value)=split(/=/,$pair); |
} |
$qresult.="$scope:".$pair."&"; |
|
} |
|
} else { |
|
foreach $key (@keys) { |
|
$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; |
|
} |
|
} |
|
} |
} |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
Line 3246 sub restore_handler {
|
Line 3260 sub restore_handler {
|
®ister_handler("restore", \&restore_handler, 0,1,0); |
®ister_handler("restore", \&restore_handler, 0,1,0); |
|
|
# |
# |
# Add a chat message to to a discussion board. |
# Add a chat message to a synchronous discussion board. |
# |
# |
# Parameters: |
# Parameters: |
# $cmd - Request keyword. |
# $cmd - Request keyword. |
# $tail - Tail of the command. A colon separated list |
# $tail - Tail of the command. A colon separated list |
# containing: |
# containing: |
# cdom - Domain on which the chat board lives |
# cdom - Domain on which the chat board lives |
# cnum - Identifier of the discussion group. |
# cnum - Course containing the chat board. |
# post - Body of the posting. |
# newpost - Body of the posting. |
|
# group - Optional group, if chat board is only |
|
# accessible in a group within the course |
# $client - Socket open on the client. |
# $client - Socket open on the client. |
# Returns: |
# Returns: |
# 1 - Indicating caller should keep on processing. |
# 1 - Indicating caller should keep on processing. |
Line 3269 sub send_chat_handler {
|
Line 3285 sub send_chat_handler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($cdom,$cnum,$newpost)=split(/\:/,$tail); |
my ($cdom,$cnum,$newpost,$group)=split(/\:/,$tail); |
&chat_add($cdom,$cnum,$newpost); |
&chat_add($cdom,$cnum,$newpost,$group); |
&Reply($client, "ok\n", $userinput); |
&Reply($client, "ok\n", $userinput); |
|
|
return 1; |
return 1; |
Line 3278 sub send_chat_handler {
|
Line 3294 sub send_chat_handler {
|
®ister_handler("chatsend", \&send_chat_handler, 0, 1, 0); |
®ister_handler("chatsend", \&send_chat_handler, 0, 1, 0); |
|
|
# |
# |
# Retrieve the set of chat messagss from a discussion board. |
# Retrieve the set of chat messages from a discussion board. |
# |
# |
# Parameters: |
# Parameters: |
# $cmd - Command keyword that initiated the request. |
# $cmd - Command keyword that initiated the request. |
Line 3288 sub send_chat_handler {
|
Line 3304 sub send_chat_handler {
|
# chat id - Discussion thread(?) |
# chat id - Discussion thread(?) |
# domain/user - Authentication domain and username |
# domain/user - Authentication domain and username |
# of the requesting person. |
# of the requesting person. |
|
# group - Optional course group containing |
|
# the board. |
# $client - Socket open on the client program. |
# $client - Socket open on the client program. |
# Returns: |
# Returns: |
# 1 - continue processing |
# 1 - continue processing |
Line 3300 sub retrieve_chat_handler {
|
Line 3318 sub retrieve_chat_handler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($cdom,$cnum,$udom,$uname)=split(/\:/,$tail); |
my ($cdom,$cnum,$udom,$uname,$group)=split(/\:/,$tail); |
my $reply=''; |
my $reply=''; |
foreach (&get_chat($cdom,$cnum,$udom,$uname)) { |
foreach (&get_chat($cdom,$cnum,$udom,$uname,$group)) { |
$reply.=&escape($_).':'; |
$reply.=&escape($_).':'; |
} |
} |
$reply=~s/\:$//; |
$reply=~s/\:$//; |
Line 4433 sub photo_permission_handler {
|
Line 4451 sub photo_permission_handler {
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my $cdom = $tail; |
my $cdom = $tail; |
my ($perm_reqd,$conditions); |
my ($perm_reqd,$conditions); |
my $outcome = &localenroll::photo_permission($cdom,\$perm_reqd, |
my $outcome; |
\$conditions); |
eval { |
&Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", |
local($SIG{__DIE__})='DEFAULT'; |
$userinput); |
$outcome = &localenroll::photo_permission($cdom,\$perm_reqd, |
|
\$conditions); |
|
}; |
|
if (!$@) { |
|
&Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", |
|
$userinput); |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
return 1; |
} |
} |
®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0); |
®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0); |
|
|
Line 4461 sub photo_check_handler {
|
Line 4488 sub photo_check_handler {
|
my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response); |
my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response); |
$result .= ':'.$response; |
$result .= ':'.$response; |
&Reply($client, &escape($result)."\n",$userinput); |
&Reply($client, &escape($result)."\n",$userinput); |
|
return 1; |
} |
} |
®ister_handler("autophotocheck",\&photo_check_handler,0,1,0); |
®ister_handler("autophotocheck",\&photo_check_handler,0,1,0); |
|
|
Line 4474 sub photo_choice_handler {
|
Line 4502 sub photo_choice_handler {
|
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my $cdom = &unescape($tail); |
my $cdom = &unescape($tail); |
my ($update,$comment) = &localenroll::manager_photo_update($cdom); |
my ($update,$comment); |
&Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); |
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
($update,$comment) = &localenroll::manager_photo_update($cdom); |
|
}; |
|
if (!$@) { |
|
&Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
return 1; |
} |
} |
®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0); |
®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0); |
|
|
Line 4508 sub student_photo_handler {
|
Line 4545 sub student_photo_handler {
|
&mkpath($path); |
&mkpath($path); |
my $file; |
my $file; |
if ($type eq 'thumbnail') { |
if ($type eq 'thumbnail') { |
$file=&localstudentphoto::fetch_thumbnail($domain,$uname); |
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$file=&localstudentphoto::fetch_thumbnail($domain,$uname); |
|
}; |
} else { |
} else { |
$file=&localstudentphoto::fetch($domain,$uname); |
$file=&localstudentphoto::fetch($domain,$uname); |
} |
} |
Line 4578 sub process_request {
|
Line 4618 sub process_request {
|
# fix all the userinput -> user_input. |
# fix all the userinput -> user_input. |
my $wasenc = 0; # True if request was encrypted. |
my $wasenc = 0; # True if request was encrypted. |
# ------------------------------------------------------------ See if encrypted |
# ------------------------------------------------------------ See if encrypted |
|
# for command |
|
# sethost:<server> |
|
# <command>:<args> |
|
# we just send it to the processor |
|
# for |
|
# sethost:<server>:<command>:<args> |
|
# we do the implict set host and then do the command |
|
if ($userinput =~ /^sethost:/) { |
|
(my $cmd,my $newid,$userinput) = split(':',$userinput,3); |
|
if (defined($userinput)) { |
|
&sethost("$cmd:$newid"); |
|
} else { |
|
$userinput = "$cmd:$newid"; |
|
} |
|
} |
|
|
if ($userinput =~ /^enc/) { |
if ($userinput =~ /^enc/) { |
$userinput = decipher($userinput); |
$userinput = decipher($userinput); |
$wasenc=1; |
$wasenc=1; |
Line 5141 sub status {
|
Line 5197 sub status {
|
$0='lond: '.$what.' '.$local; |
$0='lond: '.$what.' '.$local; |
} |
} |
|
|
# -------------------------------------------------------- Escape Special Chars |
|
|
|
sub escape { |
|
my $str=shift; |
|
$str =~ s/(\W)/"%".unpack('H2',$1)/eg; |
|
return $str; |
|
} |
|
|
|
# ----------------------------------------------------- Un-Escape Special Chars |
|
|
|
sub unescape { |
|
my $str=shift; |
|
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
return $str; |
|
} |
|
|
|
# ----------------------------------------------------------- Send USR1 to lonc |
# ----------------------------------------------------------- Send USR1 to lonc |
|
|
sub reconlonc { |
sub reconlonc { |
Line 5231 sub sub_sql_reply {
|
Line 5271 sub sub_sql_reply {
|
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Timeout => 10) |
Timeout => 10) |
or return "con_lost"; |
or return "con_lost"; |
print $sclient "$cmd\n"; |
print $sclient "$cmd:$currentdomainid\n"; |
my $answer=<$sclient>; |
my $answer=<$sclient>; |
chomp($answer); |
chomp($answer); |
if (!$answer) { $answer="con_lost"; } |
if (!$answer) { $answer="con_lost"; } |
Line 5566 sub is_author {
|
Line 5606 sub is_author {
|
|
|
# Author role should show up as a key /domain/_au |
# Author role should show up as a key /domain/_au |
|
|
my $key = "/$domain/_au"; |
my $key = "/$domain/_au"; |
my $value = $hashref->{$key}; |
my $value; |
|
if (defined($hashref)) { |
|
$value = $hashref->{$key}; |
|
} |
|
|
if(defined($value)) { |
if(defined($value)) { |
&Debug("$user @ $domain is an author"); |
&Debug("$user @ $domain is an author"); |
Line 5840 sub addline {
|
Line 5883 sub addline {
|
} |
} |
|
|
sub get_chat { |
sub get_chat { |
my ($cdom,$cname,$udom,$uname)=@_; |
my ($cdom,$cname,$udom,$uname,$group)=@_; |
|
|
my @entries=(); |
my @entries=(); |
my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom', |
my $namespace = 'nohist_chatroom'; |
|
my $namespace_inroom = 'nohist_inchatroom'; |
|
if (defined($group)) { |
|
$namespace .= '_'.$group; |
|
$namespace_inroom .= '_'.$group; |
|
} |
|
my $hashref = &tie_user_hash($cdom, $cname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref)); |
@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref)); |
Line 5851 sub get_chat {
|
Line 5900 sub get_chat {
|
} |
} |
my @participants=(); |
my @participants=(); |
my $cutoff=time-60; |
my $cutoff=time-60; |
$hashref = &tie_user_hash($cdom, $cname, 'nohist_inchatroom', |
$hashref = &tie_user_hash($cdom, $cname, $namespace_inroom, |
&GDBM_WRCREAT()); |
&GDBM_WRCREAT()); |
if ($hashref) { |
if ($hashref) { |
$hashref->{$uname.':'.$udom}=time; |
$hashref->{$uname.':'.$udom}=time; |
Line 5866 sub get_chat {
|
Line 5915 sub get_chat {
|
} |
} |
|
|
sub chat_add { |
sub chat_add { |
my ($cdom,$cname,$newchat)=@_; |
my ($cdom,$cname,$newchat,$group)=@_; |
my @entries=(); |
my @entries=(); |
my $time=time; |
my $time=time; |
my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom', |
my $namespace = 'nohist_chatroom'; |
|
my $logfile = 'chatroom.log'; |
|
if (defined($group)) { |
|
$namespace .= '_'.$group; |
|
$logfile = 'chatroom_'.$group.'.log'; |
|
} |
|
my $hashref = &tie_user_hash($cdom, $cname, $namespace, |
&GDBM_WRCREAT()); |
&GDBM_WRCREAT()); |
if ($hashref) { |
if ($hashref) { |
@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref)); |
@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref)); |
Line 5892 sub chat_add {
|
Line 5947 sub chat_add {
|
} |
} |
{ |
{ |
my $proname=&propath($cdom,$cname); |
my $proname=&propath($cdom,$cname); |
if (open(CHATLOG,">>$proname/chatroom.log")) { |
if (open(CHATLOG,">>$proname/$logfile")) { |
print CHATLOG ("$time:".&unescape($newchat)."\n"); |
print CHATLOG ("$time:".&unescape($newchat)."\n"); |
} |
} |
close(CHATLOG); |
close(CHATLOG); |
Line 6167 sub convert_photo {
|
Line 6222 sub convert_photo {
|
sub sethost { |
sub sethost { |
my ($remotereq) = @_; |
my ($remotereq) = @_; |
my (undef,$hostid)=split(/:/,$remotereq); |
my (undef,$hostid)=split(/:/,$remotereq); |
|
# ignore sethost if we are already correct |
|
if ($hostid eq $currenthostid) { |
|
return 'ok'; |
|
} |
|
|
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
$currenthostid =$hostid; |
$currenthostid =$hostid; |
Line 6592 to the client, and the connection is clo
|
Line 6652 to the client, and the connection is clo
|
IO::Socket |
IO::Socket |
IO::File |
IO::File |
Apache::File |
Apache::File |
Symbol |
|
POSIX |
POSIX |
Crypt::IDEA |
Crypt::IDEA |
LWP::UserAgent() |
LWP::UserAgent() |