# The LearningOnline Network with CAPA # Routines for messaging # # $Id: lonmsg.pm,v 1.35 2002/07/22 14:23:29 bowersj2 Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # # (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,08/06,08/08,08/09,08/10,8/13,8/15, # 10/1,11/5 Gerd Kortemeyer # YEAR=2002 # 1/1,3/18 Gerd Kortemeyer # package Apache::lonmsg; use strict; use Apache::lonnet(); use vars qw($msgcount); use HTML::TokeParser; use Apache::Constants qw(:common); use Apache::loncommon; # ===================================================================== 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); 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,$sendback)=@_; # 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') { ($msgid,$message)=&packagemsg($subject,$message); if ($sendback) { $message.='true'; } $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: '.($contents{'sendback'}? &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'}):'no msg req'); $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') { ($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}); } if (($newstatus eq 'deleted') || ($newstatus eq 'new')) { &Apache::lonnet::put('email_status',{$msgid => $newstatus}); } } # ======================================================= Display a course list sub discourse { my $r=shift; my %courselist=&Apache::lonnet::dump( 'classlist', $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); my $now=time; $r->print(<    

ENDDISHEADER foreach (sort keys %courselist) { my ($end,$start)=split(/\:/,$courselist{$_}); my $active=1; if (($end) && ($now>$end)) { $active=0; } if ($active) { my ($sname,$sdom)=split(/\:/,$_); my %reply=&Apache::lonnet::get('environment', ['firstname','middlename','lastname','generation'], $sdom,$sname); my $section=&Apache::lonnet::usection ($sdom,$sname,$ENV{'request.course.id'}); $r->print( '
'. $reply{'firstname'}.' '. $reply{'middlename'}.' '. $reply{'lastname'}.' '. $reply{'generation'}. ' ('.$_.') '.$section); } } } # ==================================================== Display Critical Message sub discrit { my $r=shift; my $header = '

Critical Messages

'. '
'. ''; my %what=&Apache::lonnet::dump('critical'); my $result = ''; foreach (sort keys %what) { my %content=&unpackagemsg($what{$_}); next if ($content{'senderdomain'} eq ''); $content{'message'}=~s/\n/\/g; $result.='
From: '.$content{'sendername'}.'@'. $content{'senderdomain'}.' ('.$content{'time'}. ')
Subject: '.$content{'subject'}. '
'.$content{'message'}.'
'. ''. ''; } # Check to see if there were any messages. if ($result eq '') { $result = "

You have no critical messages.

"; } else { $r->print($header); } $r->print($result); $r->print(''); } # =============================================================== Compose reply sub comprep { my ($r,$msgid)=@_; 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'})) { my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message"); $dispcrit= ' Send as critical message ' . $crithelp . '
'. ' Send as critical message ' . ' and return receipt' . $crithelp . '

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

Subject:

$dispcrit

ENDREPLY } # ======================================================== Display all messages sub disall { my $r=shift; $r->print(< function checkall() { for (i=0; i ENDDISHEADER $r->print( '

Display All Messages

'. ''. ''); foreach (sort split(/\&/,&Apache::lonnet::reply('keys:'. $ENV{'user.domain'}.':'. $ENV{'user.name'}.':nohist_email', $ENV{'user.home'}))) { my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)= &Apache::lonmsg::unpackmsgid($_); unless (($status eq 'deleted') || ($sendtime=~/error/)) { if ($status eq 'new') { $r->print(''); } elsif ($status eq 'read') { $r->print(''); } elsif ($status eq 'replied') { $r->print(''); } else { $r->print(''); } $r->print(''. ''); } } $r->print('
 DateUsernameDomainSubjectStatus
OpenDelete'.localtime($sendtime).''. $fromname.''.$fromdomain.''. &Apache::lonnet::unescape($shortsubj).''. $status.'

'. 'Check All '. 'Uncheck All

'. ''. '

'); } # ============================================================== Compose output sub compout { my ($r,$forwarding,$broadcast)=@_; my $dispcrit=''; my $dissub=''; my $dismsg=''; my $func='Send New'; if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message"); $dispcrit= ' Send as critical message ' . $crithelp . '
'. ' Send as critical message ' . ' and return receipt' . $crithelp . '

'; } if ($forwarding) { $dispcrit.=''; $func='Forward'; my %message=&Apache::lonnet::get('nohist_email',[$forwarding]); my %content=&unpackagemsg($message{$forwarding}); $dissub='Forwarding: '.$content{'subject'}; $dismsg='Forwarded message from '. $content{'sendername'}.' at '.$content{'senderdomain'}; } my $defdom=$ENV{'user.domain'}; $r->print( '

'."\n". ''."\n". ''); unless (($broadcast eq 'group') || ($broadcast eq 'upload')) { my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain'); $r->print(<<"ENDREC");
ENDREC } if ($broadcast ne 'upload') { $r->print(<<"ENDCOMP");
Username:
Domain: $domform
Additional Recipients
username\@domain,username\@domain, ...
Subject:

$dispcrit ENDCOMP } else { # $broadcast is 'upload' $r->print(<

Generate messages from a file

Subject:

General message text

The file format for the uploaded portion of the message is:

username1\@domain1: text
username2\@domain2: text
username3\@domain1: text

The messages will be assembled from all lines with the respective username\@domain, and appended to the general message text.

$dispcrit ENDUPLOAD } if ($broadcast eq 'group') { &discourse; } $r->print('

'); } # ===================================================================== Handler 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 &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['display','replyto','forward','markread','markdel','markunread', 'sendreply','compose','sendmail','critical']); # --------------------------------------------------------------- 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:ReplyForwardMark UnreadDisplay all Messages

'.
             $content{'message'}.'

'.$content{'citation'}); } elsif ($ENV{'form.replyto'}) { &comprep($r,$ENV{'form.replyto'}); } 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'}) || ($ENV{'form.sendbck'})) && (&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'}, $ENV{'form.sendbck'})); } else { $r->print('Sending: '.&user_normal_msg($content{'sendername'}, $content{'senderdomain'}, $ENV{'form.subject'}, $ENV{'form.message'})); } if ($ENV{'form.displayedcrit'}) { &discrit($r); } else { &disall($r); } } elsif ($ENV{'form.confirm'}) { foreach (keys %ENV) { if ($_=~/^form\.rec\_(.*)$/) { $r->print('Confirming Receipt: '. &user_crit_received($1).'
'); } if ($_=~/^form\.reprec\_(.*)$/) { my $msgid=$1; $r->print('Confirming Receipt: '. &user_crit_received($msgid).'
'); &comprep($r,$msgid); } } &discrit($r); } elsif ($ENV{'form.critical'}) { &discrit($r); } elsif ($ENV{'form.forward'}) { &compout($r,$ENV{'form.forward'}); } elsif ($ENV{'form.markread'}) { } elsif ($ENV{'form.markdel'}) { &statuschange($ENV{'form.markdel'},'deleted'); &disall($r); } elsif ($ENV{'form.markeddel'}) { my $total=0; foreach (keys %ENV) { if ($_=~/^form\.delmark_(.*)$/) { &statuschange(&Apache::lonnet::unescape($1),'deleted'); $total++; } } $r->print('Deleted '.$total.' message(s)

'); &disall($r); } elsif ($ENV{'form.markunread'}) { &statuschange($ENV{'form.markunread'},'new'); &disall($r); } elsif ($ENV{'form.compose'}) { &compout($r,'',$ENV{'form.compose'}); } elsif ($ENV{'form.sendmail'}) { my %content=(); undef %content; if ($ENV{'form.forwid'}) { my $msgid=$ENV{'form.forwid'}; my %message=&Apache::lonnet::get('nohist_email',[$msgid]); %content=&unpackagemsg($message{$msgid}); &statuschange($msgid,'forwarded'); $ENV{'form.message'}.="\n\n-- Forwarded message --\n\n". $content{'message'}; } my %toaddr=(); undef %toaddr; if ($ENV{'form.sendmode'} eq 'group') { foreach (keys %ENV) { if ($_=~/^form\.send\_to\_\&\&\&[^\&]*\&\&\&\_(.+)$/) { $toaddr{$1}=''; } } } elsif ($ENV{'form.sendmode'} eq 'upload') { foreach (split(/[\n\r\f]+/,$ENV{'form.upfile'})) { my ($rec,$txt)=split(/\s*\:\s*/,$_); if ($txt) { $rec=~s/\@/\:/; $toaddr{$rec}.=$txt."\n"; } } } else { $toaddr{$ENV{'form.recuname'}.':'.$ENV{'form.recdomain'}}=''; } if ($ENV{'form.additionalrec'}) { foreach (split(/\,/,$ENV{'form.additionalrec'})) { my ($auname,$audom)=split(/\@/,$_); $toaddr{$auname.':'.$audom}=''; } } foreach (keys %toaddr) { my ($recuname,$recdomain)=split(/\:/,$_); my $msgtxt=$ENV{'form.message'}; if ($toaddr{$_}) { $msgtxt.='


'.$toaddr{$_}; } if ((($ENV{'form.critmsg'}) || ($ENV{'form.sendbck'})) && (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) { $r->print('Sending critical: '. &user_crit_msg($recuname,$recdomain, $ENV{'form.subject'}, $msgtxt, $ENV{'form.sendbck'})); } else { $r->print('Sending: '.&user_normal_msg($recuname,$recdomain, $ENV{'form.subject'}, $msgtxt, $content{'citation'})); } $r->print('
'); } if ($ENV{'form.displayedcrit'}) { &discrit($r); } else { &disall($r); } } else { &disall($r); } $r->print(''); return OK; } # ================================================= Main program, reset counter BEGIN { $msgcount=0; } 1; __END__