# The LearningOnline Network with CAPA # # Routines for messaging # # (Routines to control the menu # # (TeX Conversion Module # # 05/29/00,05/30 Gerd Kortemeyer) # # 10/05 Gerd Kortemeyer) # # 10/19,10/20,10/30, # 02/06/01 Gerd Kortemeyer # 07/27 Guy Albertelli # 07/27,07/28,07/30,08/03 Gerd Kortemeyer package Apache::lonmsg; use strict; use Apache::lonnet(); use vars qw($msgcount); use HTML::TokeParser; use Apache::Constants qw(:common); # ===================================================================== Package sub packagemsg { my ($subject,$message,$citation)=@_; $message=~s/\/\>\;/g; $citation=~s/\/\>\;/g; $subject=~s/\/\>\;/g; my $now=time; $msgcount++; my $partsubj=$subject; $partsubj=&Apache::lonnet::escape($partsubj); $partsubj=substr($partsubj,0,50); my $msgid=&Apache::lonnet::escape( $now.':'.$partsubj.':'.$ENV{'user.name'}.':'. $ENV{'user.domain'}.':'.$msgcount.':'.$$); return $msgid, ''.$ENV{'user.name'}.''. ''.$ENV{'user.domain'}.''. ''.$subject.''. ''. ''.$ENV{'SERVER_NAME'}.''. ''.$ENV{'HTTP_HOST'}.''. ''.$ENV{'REMOTE_ADDR'}.''. ''.$ENV{'browser.type'}.''. ''.$ENV{'browser.os'}.''. ''.$ENV{'browser.version'}.''. ''.$ENV{'browser.mathml'}.''. ''.$ENV{'HTTP_USER_AGENT'}.''. ''.$ENV{'request.course.id'}.''. ''.$ENV{'request.role'}.''. ''.$ENV{'request.filename'}.''. ''.$msgid.''. ''.$message.''. ''.$citation.''; } # ================================================== Unpack message into a hash sub unpackagemsg { my $message=shift; my %content=(); my $parser=HTML::TokeParser->new(\$message); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { my $entry=$token->[1]; my $value=$parser->get_text('/'.$entry); $content{$entry}=$value; } } return %content; } # ======================================================= Get info out of msgid sub unpackmsgid { my $msgid=&Apache::lonnet::unescape(shift); my ($sendtime,$shortsubj,$fromname,$fromdomain)=split(/\:/, &Apache::lonnet::unescape($msgid)); my %status=&Apache::lonnet::get('email_status',[$msgid]); if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } unless ($status{$msgid}) { $status{$msgid}='new'; } return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid}); } # =============================== Automated message to the author of a resource sub author_res_msg { my ($filename,$message)=@_; unless ($message) { return 'empty'; } $filename=&Apache::lonnet::declutter($filename); my ($domain,$author,@dummy)=split(/\//,$filename); my $homeserver=&Apache::lonnet::homeserver($author,$domain); if ($homeserver ne 'no_host') { my $id=unpack("%32C*",$message); my $msgid; ($msgid,$message)=&packagemsg($filename,$message); return &Apache::lonnet::reply('put:'.$domain.':'.$author. ':nohist_res_msgs:'. &Apache::lonnet::escape($filename.'_'.$id).'='. &Apache::lonnet::escape($message),$homeserver); } return 'no_host'; } # ================================================== Critical message to a user sub user_crit_msg { my ($user,$domain,$subject,$message)=@_; # Check if allowed missing my $status=''; my $msgid='undefined'; unless (($message)&&($user)&&($domain)) { $status='empty'; }; my $homeserver=&Apache::lonnet::homeserver($user,$domain); if ($homeserver ne 'no_host') { my $msgid; ($msgid,$message)=&packagemsg($subject,$message); $status=&Apache::lonnet::critical( 'put:'.$domain.':'.$user.':critical:'. &Apache::lonnet::escape($msgid).'='. &Apache::lonnet::escape($message),$homeserver); } else { $status='no_host'; } &Apache::lonnet::logthis( 'Sending critical email '.$msgid. ', log status: '. &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, $ENV{'user.home'}, 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' .$status)); return $status; } # =================================================== Critical message received sub user_crit_received { my $msgid=shift; my %message=&Apache::lonnet::get('critical',[$msgid]); my %contents=&unpackagemsg($message{$msgid}); my $status='rec: '. &user_normal_msg($contents{'sendername'},$contents{'senderdomain'}, 'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}, 'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}. ' acknowledged receipt of message "'. $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n" .'Message ID: '.$contents{'msgid'}); $status.=' trans: '. &Apache::lonnet::put( 'nohist_email',{$contents{'msgid'} => $message{$msgid}}); $status.=' del: '. &Apache::lonnet::del('critical',[$contents{'msgid'}]); &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, $ENV{'user.home'},'Received critical message '. $contents{'msgid'}. ', '.$status); return $status; } # ======================================================== Normal communication sub user_normal_msg { my ($user,$domain,$subject,$message,$citation)=@_; # Check if allowed missing my $status=''; my $msgid='undefined'; unless (($message)&&($user)&&($domain)) { $status='empty'; }; my $homeserver=&Apache::lonnet::homeserver($user,$domain); if ($homeserver ne 'no_host') { my $msgid; ($msgid,$message)=&packagemsg($subject,$message,$citation); $status=&Apache::lonnet::critical( 'put:'.$domain.':'.$user.':nohist_email:'. &Apache::lonnet::escape($msgid).'='. &Apache::lonnet::escape($message),$homeserver); } else { $status='no_host'; } &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, $ENV{'user.home'}, 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); return $status; } # =============================================================== Status Change sub statuschange { my ($msgid,$newstatus)=@_; my %status=&Apache::lonnet::get('email_status',[$msgid]); if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } unless ($status{$msgid}) { $status{$msgid}='new'; } unless (($status{$msgid} eq 'replied') || ($status{$msgid} eq 'forwarded')) { &Apache::lonnet::put('email_status',{$msgid => $newstatus}); } } # ===================================================================== Handler sub discrit { my $r=shift; $r->print('

Critical Messages

'. '
'. ''); my %what=&Apache::lonnet::dump('critical'); map { my %content=&unpackagemsg($what{$_}); $content{'message'}=~s/\n/\/g; $r->print('
From: '.$content{'sendername'}.'@'. $content{'senderdomain'}.' ('.$content{'time'}. ')
'.$content{'message'}.'
'. ''); } sort keys %what; $r->print(''); } sub handler { my $r=shift; # ----------------------------------------------------------- Set document type $r->content_type('text/html'); $r->send_http_header; return OK if $r->header_only; # --------------------------- Get query string for limited number of parameters map { my ($name, $value) = split(/=/,$_); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; if (($name eq 'display') || ($name eq 'replyto') || ($name eq 'forward') || ($name eq 'mark') || ($name eq 'sendreply') || ($name eq 'compose') || ($name eq 'sendmail') || ($name eq 'critical')) { unless ($ENV{'form.'.$name}) { $ENV{'form.'.$name}=$value; } } } (split(/&/,$ENV{'QUERY_STRING'})); # --------------------------------------------------------------- Render Output $r->print('EMail and Messaging'); $r->print( ''); $r->print('

EMail

'); if ($ENV{'form.display'}) { my $msgid=$ENV{'form.display'}; &statuschange($msgid,'read'); my %message=&Apache::lonnet::get('nohist_email',[$msgid]); my %content=&unpackagemsg($message{$msgid}); $r->print('Subject: '.$content{'subject'}. '
From: '.$content{'sendername'}.' at '. $content{'senderdomain'}. '
Time: '.$content{'time'}.'
Functions: '. 'Reply
'.
             $content{'message'}.'

'.$content{'citation'}); } elsif ($ENV{'form.replyto'}) { my $msgid=$ENV{'form.replyto'}; my %message=&Apache::lonnet::get('nohist_email',[$msgid]); my %content=&unpackagemsg($message{$msgid}); my $quotemsg='> '.$content{'message'}; $quotemsg=~s/\r/\n/g; $quotemsg=~s/\f/\n/g; $quotemsg=~s/\n+/\n\> /g; my $subject='Re: '.$content{'subject'}; my $dispcrit=''; if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { $dispcrit= ' Send as critical message

'; } $r->print(<<"ENDREPLY");

Subject:

$dispcrit

ENDREPLY } elsif ($ENV{'form.sendreply'}) { my $msgid=$ENV{'form.sendreply'}; my %message=&Apache::lonnet::get('nohist_email',[$msgid]); my %content=&unpackagemsg($message{$msgid}); &statuschange($msgid,'replied'); if (($ENV{'form.critmsg'}) && (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) { $r->print('Sending critical: '. &user_crit_msg($content{'sendername'}, $content{'senderdomain'}, $ENV{'form.subject'}, $ENV{'form.message'})); } else { $r->print('Sending: '.&user_normal_msg($content{'sendername'}, $content{'senderdomain'}, $ENV{'form.subject'}, $ENV{'form.message'})); } } elsif ($ENV{'form.confirm'}) { map { if ($_=~/^form\.rec\_(.*)$/) { $r->print('Confirming Receipt: '. &user_crit_received($1).'
'); } } keys %ENV; &discrit($r); } elsif ($ENV{'form.critical'}) { &discrit($r); } elsif ($ENV{'form.forward'}) { } elsif ($ENV{'form.mark'}) { } elsif ($ENV{'form.compose'}) { my $dispcrit=''; if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { $dispcrit= ' Send as critical message

'; } $r->print(<<"ENDCOMP");

Subject:

$dispcrit

ENDCOMP } elsif ($ENV{'form.sendmail'}) { } else { $r->print(''. ''); map { my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)= &Apache::lonmsg::unpackmsgid($_); if ($status eq 'new') { $r->print(''); } elsif ($status eq 'read') { $r->print(''); } elsif ($status eq 'replied') { $r->print(''); } else { $r->print(''); } $r->print(''); } sort split(/\&/,&Apache::lonnet::reply('keys:'. $ENV{'user.domain'}.':'. $ENV{'user.name'}.':nohist_email', $ENV{'user.home'})); $r->print('
 DateUsernameDomainSubjectStatus
Open'.localtime($sendtime).''. $fromname.''.$fromdomain.''. &Apache::lonnet::unescape($shortsubj).''. $status.'
'); } $r->print(''); return OK; } # ================================================= Main program, reset counter sub BEGIN { $msgcount=0; } 1; __END__ 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.