# 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
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;
$message=~s/\>/\>\;/g;
$citation=~s/\\<\;/g;
$citation=~s/\>/\>\;/g;
$subject=~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 $message=shift;
my %contents=&unpackagemsg($message);
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);
$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);
}
# ======================================================== 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 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')) {
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'};
$r->print(<<"ENDREPLY");
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');
$r->print('Sending: '.&user_normal_msg($content{'sendername'},
$content{'senderdomain'},
$ENV{'form.subject'},
$ENV{'form.message'}));
} elsif ($ENV{'form.forward'}) {
} elsif ($ENV{'form.mark'}) {
} else {
$r->print('
 
Date
'.
'
Username
Domain
Subject
Status
');
map {
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)=
&Apache::lonmsg::unpackmsgid($_);
if ($status eq 'new') {
$r->print('