--- loncom/interface/lonchatfetch.pm 2003/03/28 23:16:25 1.8 +++ loncom/interface/lonchatfetch.pm 2021/11/30 15:55:37 1.40 @@ -1,7 +1,7 @@ # The LearningOnline Network # Chat Fetching # -# $Id: lonchatfetch.pm,v 1.8 2003/03/28 23:16:25 www Exp $ +# $Id: lonchatfetch.pm,v 1.40 2021/11/30 15:55:37 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,119 +29,235 @@ package Apache::lonchatfetch; use strict; -use Apache::Constants qw(:common); +use Apache::Constants qw(:common :http); use Apache::lontexconvert; use Apache::loncommon; use Apache::lonnet; +use Apache::longroup; +use Apache::lonlocal; +use lib '/home/httpd/lib/perl/'; +use LONCAPA; + sub handler { my $r = shift; - my $loaderror=&Apache::lonnet::overloaderror($r); - if ($loaderror) { return $loaderror; } - $loaderror= - &Apache::lonnet::overloaderror($r, - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - if ($loaderror) { return $loaderror; } + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['lastid','group']); + my ($group,$grouptitle); + my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; + if (defined($env{'form.group'})) { + $group = $env{'form.group'}; + if ((! &Apache::lonnet::allowed('pgc',$env{'request.course.id'}.'/'. + $group)) && + (! &Apache::lonnet::allowed('vcg',$env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { + return HTTP_NOT_ACCEPTABLE; + } + my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum,$group); + if (%curr_groups) { + my %group_info = + &Apache::longroup::get_group_settings($curr_groups{$group}); + $grouptitle = + ''.&unescape($group_info{description}). + '
'; + } + } elsif (! &Apache::lonnet::allowed('plc',$env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) + ) { + return HTTP_NOT_ACCEPTABLE; + } - $r->content_type('text/html'); + &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK if $r->header_only; # ------------------------------------------------------------ retrieve entries - my $cnum=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $chome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; + my $chome=$env{'course.'.$env{'request.course.id'}.'.home'}; my @entries=split(/\:/, &Apache::lonnet::reply( - "chatretr:$cdom:$cnum:$ENV{'user.domain'}:$ENV{'user.name'}",$chome)); - my ($lastid)=($entries[$#entries]=~/^(\w+)/); - my ($thentime,$idnum)=split(/\_/,$lastid); + "chatretr:$cdom:$cnum:$env{'user.domain'}:$env{'user.name'}:$group", + $chome)); +# Figure out what the last valid entry-id is + my ($lastid,$thentime,$idnum); + foreach my $entry (@entries) { + $entry =~/^(\w+)/; + if ($1 ne 'active_participant') { + $lastid=$1; + ($thentime,$idnum)=split(/\_/,$lastid); + } + } # ----------------------------------------------------------- Can see identity? - my $crs='/'.$ENV{'request.course.id'}; - if ($ENV{'request.course.sec'}) { - $crs.='_'.$ENV{'request.course.sec'}; - } - $crs=~s/\_/\//g; - my $seeid=&Apache::lonnet::allowed('rin',$crs); + my $seeid = &get_seeid_status(); # -------------------------------------------------------- see which ones apply - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['lastid']); my $include=0; + my $header; my $newstuff=''; my $bottomid=''; - unless ($ENV{'form.lastid'}) { - $include=1; - $newstuff=''; - } - foreach (@entries) { - if ($include) { - my ($id,$msg,$uname)=split(/\:/,&Apache::lonnet::unescape($_)); - if ($id eq 'active_participant') { -# $newstuff.='participant: '.$msg.' '.$uname; - } else { - chomp($msg); - my ($msgtime,$msgnum)=split(/\_/,$id); - my ($sdom,$snum,$anon,$contrib)=split(/\:/, - &Apache::lonnet::unescape($msg)); - $contrib=&Apache::lonnet::unescape($contrib); - $contrib=~s/\n/\
/g; - $contrib=&Apache::lontexconvert::msgtexconverted($contrib); - $contrib=~s/\n/ /g; - $contrib=~s/\'/\&\#39\;/g; - my $sender=''; - if ($seeid) { - $sender=&Apache::loncommon::plainname($snum,$sdom); - my $nick=&Apache::loncommon::nickname($snum,$sdom); - if (($nick) && ($nick ne $sender)) { - $sender.=' '.$nick; - } - if ($anon) { $sender.=' [Anon]' }; - } elsif (!$anon) { - $sender=&Apache::loncommon::nickname($snum,$sdom); - } else { - $sender=&Apache::loncommon::screenname($snum,$sdom); - unless ($sender) { $sender="Anonymous"; } + unless ($env{'form.lastid'}) { + $include=1; + $header = + &Apache::loncommon::start_page(undef,undef, + {'only_body' => 1, + 'bgcolor' => '#FFFFFF', + 'js_ready' => 1,}); + } + my @participants=(); + foreach my $entry (@entries) { + my ($id,$msg,$udom)=split(/\:/,&unescape($entry)); + if ($id eq 'active_participant') { + chomp($udom); + my $participant= &Apache::loncommon::nickname($msg,$udom); + unless ($participant=~/\w/) { $participant=$msg.':'.$udom; } + $participants[$#participants+1]=$participant; + } elsif ($include) { + chomp($msg); + my ($msgtime,$msgnum)=split(/\_/,$id); + my ($sdom,$snum,$anon,$contrib)=split(/\:/, + &unescape($msg)); + $contrib=&unescape($contrib); + &Apache::lonfeedback::newline_to_br(\$contrib); + ($contrib,my $errors)=&Apache::lontexconvert::msgtexconverted($contrib); + if ($errors) { + $contrib.=' ' + .&mt('(Message not fully displayed due to incorrect embedded TeX.)') + .''; + } + if ($errors && $snum eq $env{'user.name'} && + $sdom eq $env{'user.domain'} ) { + $contrib.='
' + .&mt('TeX error message: [_1]',$errors) + .''; + } + $contrib=~s/\n/ /g; + $contrib=~s/\'/\&\#39\;/g; + my $sender=''; + if ($seeid) { + $sender=&Apache::loncommon::plainname($snum,$sdom); + my $nick=&Apache::loncommon::nickname($snum,$sdom); + if (($nick) && ($nick ne $sender)) { + $sender.=' '.$nick; } - $sender=~s/\'/\"/g; - my $color=$sender; - $color=~tr/a-j/0-9/; - $color=~tr/A-J/0-9/; - $color=~tr/k-t/0-9/; - $color=~tr/K-T/0-9/; - $color=~tr/u-z/0-5/; - $color=~tr/U-Z/0-5/; - $color=~s/\D//g; - $color=substr($color,0,6); - my $timestamp=localtime($msgtime); - my ($mhour,$mmin,$msec)=($timestamp=~/(\d\d)\:(\d\d)\:(\d\d)/); - $newstuff.=''. - $sender.' ('.$mhour.':'.$mmin.':'.$msec.'): '. - $contrib."
"; - $bottomid=$id; + unless ($sender) { $sender=$snum.':'.$sdom; } + if ($anon) { $sender.=' [Anon]' }; + } elsif (!$anon) { + $sender=&Apache::loncommon::nickname($snum,$sdom); + unless ($sender) { $sender=$snum.':'.$sdom; } + } else { + $sender=&Apache::loncommon::screenname($snum,$sdom); + unless ($sender) { $sender=&mt("Anonymous"); } } - } else { - $_=~/^(\w+)/; - if ($1 eq $ENV{'form.lastid'}) { $include=1; } - } + $sender=~s/\'/\&\#39\;/g; + my $color=$sender; + $color=~tr/a-j/0-9/; + $color=~tr/A-J/0-9/; + $color=~tr/k-t/0-9/; + $color=~tr/K-T/0-9/; + $color=~tr/u-z/0-5/; + $color=~tr/U-Z/0-5/; + $color=~s/\D//g; + $color=substr($color,0,6); + my $timestamp=localtime($msgtime); + my ($mhour,$mmin,$msec)=($timestamp=~/(\d\d)\:(\d\d)\:(\d\d)/); + $newstuff.=''. + $sender.' ('.$mhour.':'.$mmin.':'.$msec.'): '. + $contrib."
"; + $bottomid='LC_'.$id; + } else { + $entry=~/^(\w+)/; + if ($1 eq $env{'form.lastid'}) { $include=1; } + } + } + my $participant_output=join('
',sort @participants); + my $refresh_cmd = "/adm/chatfetch?lastid=$lastid"; + if (defined($group)) { + $refresh_cmd .= "&group=$group"; } + my $headarg; + my $clientip = &Apache::lonnet::get_requestor_ip($r); + my ($blocked,$blocktext) = &blockstatus($clientip); + if ($blocked) { + $newstuff = $blocktext; + $headarg = {'only_body' => 1,}; + + $r->print(< + parent.location.href="/adm/blockingstatus/?activity=chat" + +ENDSCRIPT + } else { + $headarg = {'redirect' => [5,$refresh_cmd,1], + 'only_body' => 1,}; + } + my $start_page = &Apache::loncommon::start_page('Chat Room',undef,$headarg); + my $end_page = &Apache::loncommon::end_page(); $r->print(< - -The LearningOnline Network with CAPA - - - - - - +$grouptitle +$participant_output +$end_page ENDDOCUMENT return OK; -} +} + +sub get_seeid_status { + my $crs='/'.$env{'request.course.id'}; + my $seeid; + if (exists($env{'form.group'})) { + $seeid = &Apache::lonnet::allowed('rci',$crs.'/'.$env{'form.group'}); + } else { + if ($env{'request.course.sec'}) { + $crs.='_'.$env{'request.course.sec'}; + } + $crs=~s/\_/\//g; + $seeid=&Apache::lonnet::allowed('rin',$crs); + } + return $seeid; +} + +sub blockstatus { + my ($clientip) = @_; + my ($blocked,$output); + my %setters; + my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = + &Apache::loncommon::blockcheck(\%setters,'chat',$clientip); + if ($startblock && $endblock) { + $blocked = 1; + my $endblocktime = &Apache::lonlocal::locallocaltime($endblock); + $output .= &mt('Chat Room will be unavailable to you until [_1] because communication is blocked in one or more of your courses:',$endblocktime).'

'; + foreach my $course (keys(%setters)) { + my %courseinfo=&Apache::lonnet::coursedescription($course); + for (my $i=0; $i<@{$setters{$course}{staff}}; $i++) { + my ($uname,$udom) = @{$setters{$course}{staff}[$i]}; + my $fullname = &Apache::loncommon::plainname($uname,$udom); + my ($openblock,$closeblock) = @{$setters{$course}{times}[$i]}; + $openblock = &Apache::lonlocal::locallocaltime($openblock); + $closeblock= &Apache::lonlocal::locallocaltime($closeblock); + $output .= &mt('Block for [_1] starts: [_2], ends [_3], set by: [_4]',$courseinfo{'description'},$openblock,$closeblock,$fullname).'
'; + } + } + } elsif ($by_ip) { + $blocked = 1; + my $showdom = &Apache::lonnet::domain($blockdom); + if ($showdom eq '') { + $showdom = $blockdom; + } + $output = &mt('Chat Room is unavailable from your current IP address: [_1], ' + .'because communication is blocked for certain IP address(es).' + ,$clientip). + '
'. + &mt('This restriction was set by an administrator in the [_1] LON-CAPA domain.' + ,$showdom); + } + return ($blocked,$output); +} 1; __END__