|
version 1.16, 2001/08/06 11:41:11
|
version 1.187, 2006/12/05 02:55:53
|
|
Line 1
|
Line 1
|
| # The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
| # |
|
| # Routines for messaging |
# Routines for messaging |
| # |
# |
| # (Routines to control the menu |
# $Id$ |
| |
# |
| |
# 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. |
| # |
# |
| # (TeX Conversion Module |
# 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. |
| # |
# |
| # 05/29/00,05/30 Gerd Kortemeyer) |
# 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 |
| # |
# |
| # 10/05 Gerd Kortemeyer) |
# /home/httpd/html/adm/gpl.txt |
| |
# |
| |
# http://www.lon-capa.org/ |
| # |
# |
| # 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 Gerd Kortemeyer |
|
| |
|
| package Apache::lonmsg; |
package Apache::lonmsg; |
| |
|
| use strict; |
use strict; |
| use Apache::lonnet(); |
use Apache::lonnet; |
| use vars qw($msgcount); |
use HTML::TokeParser(); |
| use HTML::TokeParser; |
use Apache::lonlocal; |
| use Apache::Constants qw(:common); |
use Mail::Send; |
| |
use LONCAPA qw(:DEFAULT :match); |
| |
|
| |
{ |
| |
my $uniq; |
| |
sub get_uniq { |
| |
$uniq++; |
| |
return $uniq; |
| |
} |
| |
} |
| |
|
| # ===================================================================== Package |
# ===================================================================== Package |
| |
|
| sub packagemsg { |
sub packagemsg { |
| my ($subject,$message,$citation)=@_; |
my ($subject,$message,$citation,$baseurl,$attachmenturl, |
| $message=~s/\</\<\;/g; |
$recuser,$recdomain,$msgid,$type,$crsmsgid)=@_; |
| $message=~s/\>/\>\;/g; |
$message =&HTML::Entities::encode($message,'<>&"'); |
| $citation=~s/\</\<\;/g; |
$citation=&HTML::Entities::encode($citation,'<>&"'); |
| $citation=~s/\>/\>\;/g; |
$subject =&HTML::Entities::encode($subject,'<>&"'); |
| $subject=~s/\</\<\;/g; |
#remove machine specification |
| $subject=~s/\>/\>\;/g; |
$baseurl =~ s|^http://[^/]+/|/|; |
| |
$baseurl =&HTML::Entities::encode($baseurl,'<>&"'); |
| |
#remove machine specification |
| |
$attachmenturl =~ s|^http://[^/]+/|/|; |
| |
$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); |
| |
my $course_context; |
| |
if (defined($env{'form.replyid'})) { |
| |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)= |
| |
split(/\:/,&unescape($env{'form.replyid'})); |
| |
$course_context = $origcid; |
| |
} |
| |
foreach my $key (keys(%env)) { |
| |
if ($key=~/^form\.(rep)?rec\_(.*)$/) { |
| |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) = |
| |
split(/\:/,&unescape($2)); |
| |
$course_context = $origcid; |
| |
last; |
| |
} |
| |
} |
| |
unless(defined($course_context)) { |
| |
$course_context = $env{'request.course.id'}; |
| |
} |
| my $now=time; |
my $now=time; |
| $msgcount++; |
my $msgcount = &get_uniq(); |
| my $partsubj=$subject; |
unless(defined($msgid)) { |
| $partsubj=&Apache::lonnet::escape($partsubj); |
$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, |
| $partsubj=substr($partsubj,0,50); |
$msgcount,$course_context,$$); |
| my $msgid=&Apache::lonnet::escape( |
} |
| $now.':'.$partsubj.':'.$ENV{'user.name'}.':'. |
my $result = '<sendername>'.$env{'user.name'}.'</sendername>'. |
| $ENV{'user.domain'}.':'.$msgcount.':'.$$); |
'<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. |
| return $msgid, |
|
| '<sendername>'.$ENV{'user.name'}.'</sendername>'. |
|
| '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'. |
|
| '<subject>'.$subject.'</subject>'. |
'<subject>'.$subject.'</subject>'. |
| '<time>'.localtime($now).'</time>'. |
'<time>'.&Apache::lonlocal::locallocaltime($now).'</time>'; |
| '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'. |
if (defined($crsmsgid)) { |
| |
$result.= '<courseid>'.$course_context.'</courseid>'. |
| |
'<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. |
| |
'<msgid>'.$msgid.'</msgid>'. |
| |
'<coursemsgid>'.$crsmsgid.'</coursemsgid>'. |
| |
'<message>'.$message.'</message>'; |
| |
return ($msgid,$result); |
| |
} |
| |
$result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'. |
| '<host>'.$ENV{'HTTP_HOST'}.'</host>'. |
'<host>'.$ENV{'HTTP_HOST'}.'</host>'. |
| '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'. |
'<client>'.$ENV{'REMOTE_ADDR'}.'</client>'. |
| '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'. |
'<browsertype>'.$env{'browser.type'}.'</browsertype>'. |
| '<browseros>'.$ENV{'browser.os'}.'</browseros>'. |
'<browseros>'.$env{'browser.os'}.'</browseros>'. |
| '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'. |
'<browserversion>'.$env{'browser.version'}.'</browserversion>'. |
| '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'. |
'<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'. |
| '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'. |
'<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'. |
| '<courseid>'.$ENV{'request.course.id'}.'</courseid>'. |
'<courseid>'.$course_context.'</courseid>'. |
| '<role>'.$ENV{'request.role'}.'</role>'. |
'<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. |
| '<resource>'.$ENV{'request.filename'}.'</resource>'. |
'<role>'.$env{'request.role'}.'</role>'. |
| '<msgid>'.$msgid.'</msgid>'. |
'<resource>'.$env{'request.filename'}.'</resource>'. |
| '<message>'.$message.'</message>'. |
'<msgid>'.$msgid.'</msgid>'; |
| '<citation>'.$citation.'</citation>'; |
if (ref($recuser) eq 'ARRAY') { |
| |
for (my $i=0; $i<@{$recuser}; $i++) { |
| |
if ($type eq 'dcmail') { |
| |
my ($username,$email) = split(/:/,$$recuser[$i]); |
| |
$username = &unescape($username); |
| |
$email = &unescape($email); |
| |
$username = &HTML::Entities::encode($username,'<>&"'); |
| |
$email = &HTML::Entities::encode($email,'<>&"'); |
| |
$result .= '<recipient username="'.$username.'">'. |
| |
$email.'</recipient>'; |
| |
} else { |
| |
$result .= '<recuser>'.$$recuser[$i].'</recuser>'. |
| |
'<recdomain>'.$$recdomain[$i].'</recdomain>'; |
| |
} |
| |
} |
| |
} else { |
| |
$result .= '<recuser>'.$recuser.'</recuser>'. |
| |
'<recdomain>'.$recdomain.'</recdomain>'; |
| |
} |
| |
$result .= '<message>'.$message.'</message>'; |
| |
if (defined($citation)) { |
| |
$result.='<citation>'.$citation.'</citation>'; |
| |
} |
| |
if (defined($baseurl)) { |
| |
$result.= '<baseurl>'.$baseurl.'</baseurl>'; |
| |
} |
| |
if (defined($attachmenturl)) { |
| |
$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>'; |
| |
} |
| |
return $msgid,$result; |
| } |
} |
| |
|
| # ================================================== Unpack message into a hash |
# ================================================== Unpack message into a hash |
| |
|
| sub unpackagemsg { |
sub unpackagemsg { |
| my $message=shift; |
my ($message,$notoken)=@_; |
| my %content=(); |
my %content=(); |
| my $parser=HTML::TokeParser->new(\$message); |
my $parser=HTML::TokeParser->new(\$message); |
| my $token; |
my $token; |
|
Line 73 sub unpackagemsg {
|
Line 148 sub unpackagemsg {
|
| if ($token->[0] eq 'S') { |
if ($token->[0] eq 'S') { |
| my $entry=$token->[1]; |
my $entry=$token->[1]; |
| my $value=$parser->get_text('/'.$entry); |
my $value=$parser->get_text('/'.$entry); |
| $content{$entry}=$value; |
if (($entry eq 'recuser') || ($entry eq 'recdomain')) { |
| |
push(@{$content{$entry}},$value); |
| |
} elsif ($entry eq 'recipient') { |
| |
my $username = $token->[2]{'username'}; |
| |
$username = &HTML::Entities::decode($username,'<>&"'); |
| |
$content{$entry}{$username} = $value; |
| |
} else { |
| |
$content{$entry}=$value; |
| |
} |
| |
} |
| |
} |
| |
if (!exists($content{'recuser'})) { $content{'recuser'} = []; } |
| |
if ($content{'attachmenturl'}) { |
| |
my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); |
| |
if ($notoken) { |
| |
$content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>'; |
| |
} else { |
| |
&Apache::lonnet::allowuploaded('/adm/msg', |
| |
$content{'attachmenturl'}); |
| |
$content{'message'}.='<p>'.&mt('Attachment'). |
| |
': <a href="'.$content{'attachmenturl'}.'"><tt>'. |
| |
$fname.'</tt></a>'; |
| } |
} |
| } |
} |
| return %content; |
return %content; |
|
Line 81 sub unpackagemsg {
|
Line 177 sub unpackagemsg {
|
| |
|
| # ======================================================= Get info out of msgid |
# ======================================================= Get info out of msgid |
| |
|
| |
sub buildmsgid { |
| |
my ($now,$subject,$uname,$udom,$msgcount,$course_context,$pid) = @_; |
| |
$subject=&escape($subject); |
| |
return(&escape($now.':'.$subject.':'.$uname.':'. |
| |
$udom.':'.$msgcount.':'.$course_context.':'.$pid)); |
| |
} |
| |
|
| sub unpackmsgid { |
sub unpackmsgid { |
| my $msgid=&Apache::lonnet::unescape(shift); |
my ($msgid,$folder,$skipstatus,$status_cache)=@_; |
| my ($sendtime,$shortsubj,$fromname,$fromdomain)=split(/\:/, |
$msgid=&unescape($msgid); |
| &Apache::lonnet::unescape($msgid)); |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, |
| my %status=&Apache::lonnet::get('email_status',[$msgid]); |
$processid)=split(/\:/,&unescape($msgid)); |
| if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } |
$shortsubj = &unescape($shortsubj); |
| unless ($status{$msgid}) { $status{$msgid}='new'; } |
$shortsubj = &HTML::Entities::decode($shortsubj); |
| return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid}); |
if (!defined($processid)) { $fromcid = ''; } |
| } |
my %status=(); |
| |
unless ($skipstatus) { |
| |
if (ref($status_cache)) { |
| |
$status{$msgid} = $status_cache->{$msgid}; |
| |
} else { |
| |
my $suffix=&foldersuffix($folder); |
| |
%status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); |
| |
} |
| |
if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } |
| |
unless ($status{$msgid}) { $status{$msgid}='new'; } |
| |
} |
| |
return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid); |
| |
} |
| |
|
| |
|
| |
sub sendemail { |
| |
my ($to,$subject,$body)=@_; |
| |
my %senderemails=&Apache::loncommon::getemails(); |
| |
my $senderaddress=''; |
| |
foreach my $type ('notification','permanentemail','critnotification') { |
| |
if ($senderemails{$type}) { |
| |
$senderaddress=$senderemails{$type}; |
| |
} |
| |
} |
| |
$body= |
| |
"*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n". |
| |
"*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ". |
| |
&mt('A reply will not be received by the recipient!'))."\n\n".$body; |
| |
my $msg = new Mail::Send; |
| |
$msg->to($to); |
| |
$msg->subject('[LON-CAPA] '.$subject); |
| |
if ($senderaddress) { $msg->add('Reply-to',$senderaddress); } |
| |
if (my $fh = $msg->open()) { |
| |
print $fh $body; |
| |
$fh->close; |
| |
} |
| |
} |
| |
|
| |
# ==================================================== Send notification emails |
| |
|
| |
sub sendnotification { |
| |
my ($to,$touname,$toudom,$subj,$crit,$text)=@_; |
| |
my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; |
| |
unless ($sender=~/\w/) { |
| |
$sender=$env{'user.name'}.'@'.$env{'user.domain'}; |
| |
} |
| |
my $critical=($crit?' critical':''); |
| |
$text=~s/\<\;/\</gs; |
| |
$text=~s/\>\;/\>/gs; |
| |
$text=~s/\<\/*[^\>]+\>//gs; |
| |
my $url='http://'. |
| |
$Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}. |
| |
'/adm/email?username='.$touname.'&domain='.$toudom; |
| |
my $body=(<<ENDMSG); |
| |
You received a$critical message from $sender in LON-CAPA. The subject is |
| |
|
| |
$subj |
| |
|
| |
=== Excerpt ============================================================ |
| |
$text |
| |
======================================================================== |
| |
|
| |
Use |
| |
|
| |
$url |
| |
|
| |
to access the full message. |
| |
ENDMSG |
| |
&sendemail($to,'New'.$critical.' message from '.$sender,$body); |
| |
} |
| |
# ============================================================= Check for email |
| |
|
| |
sub newmail { |
| |
if ((time-$env{'user.mailcheck.time'})>300) { |
| |
my %what=&Apache::lonnet::get('email_status',['recnewemail']); |
| |
&Apache::lonnet::appenv('user.mailcheck.time'=>time); |
| |
if ($what{'recnewemail'}>0) { return 1; } |
| |
} |
| |
return 0; |
| |
} |
| |
|
| # =============================== Automated message to the author of a resource |
# =============================== Automated message to the author of a resource |
| |
|
| |
=pod |
| |
|
| |
=item * B<author_res_msg($filename, $message)>: Sends message $message to the owner |
| |
of the resource with the URI $filename. |
| |
|
| |
=cut |
| |
|
| sub author_res_msg { |
sub author_res_msg { |
| my ($filename,$message)=@_; |
my ($filename,$message)=@_; |
| unless ($message) { return 'empty'; } |
unless ($message) { return 'empty'; } |
|
Line 101 sub author_res_msg {
|
Line 290 sub author_res_msg {
|
| my $homeserver=&Apache::lonnet::homeserver($author,$domain); |
my $homeserver=&Apache::lonnet::homeserver($author,$domain); |
| if ($homeserver ne 'no_host') { |
if ($homeserver ne 'no_host') { |
| my $id=unpack("%32C*",$message); |
my $id=unpack("%32C*",$message); |
| |
$message .= " <p>This error occurred on machine ". |
| |
$Apache::lonnet::perlvar{'lonHostID'}."</p>"; |
| my $msgid; |
my $msgid; |
| ($msgid,$message)=&packagemsg($filename,$message); |
($msgid,$message)=&packagemsg($filename,$message); |
| return &Apache::lonnet::reply('put:'.$domain.':'.$author. |
return &Apache::lonnet::reply('put:'.$domain.':'.$author. |
| ':nohist_res_msgs:'. |
':nohist_res_msgs:'. |
| &Apache::lonnet::escape($filename.'_'.$id).'='. |
&escape($filename.'_'.$id).'='. |
| &Apache::lonnet::escape($message),$homeserver); |
&escape($message),$homeserver); |
| } |
} |
| return 'no_host'; |
return 'no_host'; |
| } |
} |
| |
|
| |
# =========================================== Retrieve author resource messages |
| |
|
| |
sub retrieve_author_res_msg { |
| |
my $url=shift; |
| |
$url=&Apache::lonnet::declutter($url); |
| |
my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); |
| |
my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author); |
| |
my $msgs=''; |
| |
foreach (keys %errormsgs) { |
| |
if ($_=~/^\Q$url\E\_\d+$/) { |
| |
my %content=&unpackagemsg($errormsgs{$_}); |
| |
$msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'. |
| |
$content{'time'}.'</b>: '.$content{'message'}. |
| |
'<br /></p>'; |
| |
} |
| |
} |
| |
return $msgs; |
| |
} |
| |
|
| |
|
| |
# =============================== Delete all author messages related to one URL |
| |
|
| |
sub del_url_author_res_msg { |
| |
my $url=shift; |
| |
$url=&Apache::lonnet::declutter($url); |
| |
my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); |
| |
my @delmsgs=(); |
| |
foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { |
| |
if ($_=~/^\Q$url\E\_\d+$/) { |
| |
push (@delmsgs,$_); |
| |
} |
| |
} |
| |
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); |
| |
} |
| |
# =================================== Clear out all author messages in URL path |
| |
|
| |
sub clear_author_res_msg { |
| |
my $url=shift; |
| |
$url=&Apache::lonnet::declutter($url); |
| |
my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); |
| |
my @delmsgs=(); |
| |
foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { |
| |
if ($_=~/^\Q$url\E/) { |
| |
push (@delmsgs,$_); |
| |
} |
| |
} |
| |
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); |
| |
} |
| |
# ================= Return hash with URLs for which there is a resource message |
| |
|
| |
sub all_url_author_res_msg { |
| |
my ($author,$domain)=@_; |
| |
my %returnhash=(); |
| |
foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { |
| |
$_=~/^(.+)\_\d+/; |
| |
$returnhash{$1}=1; |
| |
} |
| |
return %returnhash; |
| |
} |
| |
|
| |
# ====================================== Add a comment to the User Notes screen |
| |
|
| |
sub store_instructor_comment { |
| |
my ($msg,$uname,$udom) = @_; |
| |
my $cid = $env{'request.course.id'}; |
| |
my $cnum = $env{'course.'.$cid.'.num'}; |
| |
my $cdom = $env{'course.'.$cid.'.domain'}; |
| |
my $subject= &mt('Record').' ['.$uname.':'.$udom.']'; |
| |
my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg); |
| |
return $result; |
| |
} |
| |
|
| # ================================================== Critical message to a user |
# ================================================== Critical message to a user |
| |
|
| sub user_crit_msg { |
sub user_crit_msg_raw { |
| my ($user,$domain,$subject,$message)=@_; |
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_; |
| # Check if allowed missing |
# Check if allowed missing |
| my $status=''; |
my $status=''; |
| my $msgid='undefined'; |
my $msgid='undefined'; |
| unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
| |
my $text=$message; |
| my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
| if ($homeserver ne 'no_host') { |
if ($homeserver ne 'no_host') { |
| my $msgid; |
|
| ($msgid,$message)=&packagemsg($subject,$message); |
($msgid,$message)=&packagemsg($subject,$message); |
| |
if ($sendback) { $message.='<sendback>true</sendback>'; } |
| $status=&Apache::lonnet::critical( |
$status=&Apache::lonnet::critical( |
| 'put:'.$domain.':'.$user.':critical:'. |
'put:'.$domain.':'.$user.':critical:'. |
| &Apache::lonnet::escape($msgid).'='. |
&escape($msgid).'='. |
| &Apache::lonnet::escape($message),$homeserver); |
&escape($message),$homeserver); |
| |
if (defined($sentmessage)) { |
| |
$$sentmessage = $message; |
| |
} |
| } else { |
} else { |
| $status='no_host'; |
$status='no_host'; |
| } |
} |
| |
# Notifications |
| |
my %userenv = &Apache::loncommon::getemails($user,$domain); |
| |
if ($userenv{'critnotification'}) { |
| |
&sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, |
| |
$text); |
| |
} |
| |
if ($toperm && $userenv{'permanentemail'}) { |
| |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, |
| |
$text); |
| |
} |
| |
# Log this |
| &Apache::lonnet::logthis( |
&Apache::lonnet::logthis( |
| 'Sending critical email '.$msgid. |
'Sending critical email '.$msgid. |
| ', log status: '. |
', log status: '. |
| &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, |
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, |
| $ENV{'user.home'}, |
$env{'user.home'}, |
| 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' |
'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' |
| .$status)); |
.$status)); |
| return $status; |
return $status; |
| } |
} |
| |
|
| |
# New routine that respects "forward" and calls old routine |
| |
|
| |
=pod |
| |
|
| |
=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: Sends |
| |
a critical message $message to the $user at $domain. If $sendback is true, |
| |
a reciept will be sent to the current user when $user recieves the message. |
| |
|
| |
Additionally it will check if the user has a Forwarding address |
| |
set, and send the message to that address instead |
| |
|
| |
returns |
| |
- in array context a list of results for each message that was sent |
| |
- in scalar context a space seperated list of results for each |
| |
message sent |
| |
|
| |
=cut |
| |
|
| |
sub user_crit_msg { |
| |
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_; |
| |
my @status; |
| |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
| |
$domain,$user); |
| |
my $msgforward=$userenv{'msgforward'}; |
| |
if ($msgforward) { |
| |
foreach my $addr (split(/\,/,$msgforward)) { |
| |
my ($forwuser,$forwdomain)=split(/\:/,$addr); |
| |
push(@status, |
| |
&user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, |
| |
$sendback,$toperm,$sentmessage)); |
| |
} |
| |
} else { |
| |
push(@status, |
| |
&user_crit_msg_raw($user,$domain,$subject,$message,$sendback, |
| |
$toperm,$sentmessage)); |
| |
} |
| |
if (wantarray) { |
| |
return @status; |
| |
} |
| |
return join(' ',@status); |
| |
} |
| |
|
| # =================================================== Critical message received |
# =================================================== Critical message received |
| |
|
| sub user_crit_received { |
sub user_crit_received { |
| my $msgid=shift; |
my $msgid=shift; |
| my %message=&Apache::lonnet::get('critical',[$msgid]); |
my %message=&Apache::lonnet::get('critical',[$msgid]); |
| my %contents=&unpackagemsg($message{$msgid}); |
my %contents=&unpackagemsg($message{$msgid},1); |
| my $status='rec: '. |
my $status='rec: '.($contents{'sendback'}? |
| &user_normal_msg($contents{'sendername'},$contents{'senderdomain'}, |
&user_normal_msg($contents{'sendername'},$contents{'senderdomain'}, |
| 'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}, |
&mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'}, |
| 'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
&mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}. |
| ' acknowledged receipt of message "'. |
' acknowledged receipt of message'."\n".' "'. |
| $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n" |
$contents{'subject'}.'"'."\n".&mt('dated').' '. |
| .'Message ID: '.$contents{'msgid'}); |
$contents{'time'}.".\n" |
| |
):'no msg req'); |
| $status.=' trans: '. |
$status.=' trans: '. |
| &Apache::lonnet::put( |
&Apache::lonnet::put( |
| 'nohist_email',{$contents{'msgid'} => $message{$msgid}}); |
'nohist_email',{$contents{'msgid'} => $message{$msgid}}); |
| $status.=' del: '. |
$status.=' del: '. |
| &Apache::lonnet::del('critical',[$contents{'msgid'}]); |
&Apache::lonnet::del('critical',[$contents{'msgid'}]); |
| &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, |
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, |
| $ENV{'user.home'},'Received critical message '. |
$env{'user.home'},'Received critical message '. |
| $contents{'msgid'}. |
$contents{'msgid'}. |
| ', '.$status); |
', '.$status); |
| return $status; |
return $status; |
|
Line 167 sub user_crit_received {
|
Line 488 sub user_crit_received {
|
| |
|
| # ======================================================== Normal communication |
# ======================================================== Normal communication |
| |
|
| sub user_normal_msg { |
sub user_normal_msg_raw { |
| my ($user,$domain,$subject,$message,$citation)=@_; |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
| |
$toperm,$currid,$newid,$sentmessage,$crsmsgid)=@_; |
| # Check if allowed missing |
# Check if allowed missing |
| my $status=''; |
my ($status,$packed_message); |
| my $msgid='undefined'; |
my $msgid='undefined'; |
| |
my $text=$message; |
| unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
| my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
| if ($homeserver ne 'no_host') { |
if ($homeserver ne 'no_host') { |
| my $msgid; |
($msgid,$packed_message)= |
| ($msgid,$message)=&packagemsg($subject,$message,$citation); |
&packagemsg($subject,$message,$citation,$baseurl, |
| |
$attachmenturl,$user,$domain,$currid, |
| |
undef,$crsmsgid); |
| |
|
| |
# Store in user folder |
| $status=&Apache::lonnet::critical( |
$status=&Apache::lonnet::critical( |
| 'put:'.$domain.':'.$user.':nohist_email:'. |
'put:'.$domain.':'.$user.':nohist_email:'. |
| &Apache::lonnet::escape($msgid).'='. |
&escape($msgid).'='. |
| &Apache::lonnet::escape($message),$homeserver); |
&escape($packed_message),$homeserver); |
| |
# Save new message received time |
| |
&Apache::lonnet::put |
| |
('email_status',{'recnewemail'=>time},$domain,$user); |
| |
# Into sent-mail folder unless a broadcast message or critical message |
| |
unless (($env{'request.course.id'}) && |
| |
(($env{'form.sendmode'} eq 'group') || |
| |
(($env{'form.critmsg'}) || ($env{'form.sendbck'})) && |
| |
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}) |
| |
|| &Apache::lonnet::allowed('srm',$env{'request.course.id'}. |
| |
'/'.$env{'request.course.sec'})))) { |
| |
(undef, my $packed_message_no_citation)= |
| |
&packagemsg($subject,$message,undef ,$baseurl, |
| |
$attachmenturl,$user,$domain,$currid, |
| |
undef,$crsmsgid); |
| |
|
| |
$status .= &store_sent_mail($msgid,$packed_message_no_citation); |
| |
} |
| } else { |
} else { |
| $status='no_host'; |
$status='no_host'; |
| } |
} |
| &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, |
if (defined($newid)) { |
| $ENV{'user.home'}, |
$$newid = $msgid; |
| |
} |
| |
if (defined($sentmessage)) { |
| |
$$sentmessage = $packed_message; |
| |
} |
| |
|
| |
# Notifications |
| |
my %userenv = &Apache::lonnet::get('environment',['notification', |
| |
'permanentemail'], |
| |
$domain,$user); |
| |
if ($userenv{'notification'}) { |
| |
&sendnotification($userenv{'notification'},$user,$domain,$subject,0, |
| |
$text); |
| |
} |
| |
if ($toperm && $userenv{'permanentemail'}) { |
| |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, |
| |
$text); |
| |
} |
| |
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, |
| |
$env{'user.home'}, |
| 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); |
'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); |
| return $status; |
return $status; |
| } |
} |
| |
|
| # =============================================================== Status Change |
# New routine that respects "forward" and calls old routine |
| |
|
| sub statuschange { |
=pod |
| 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 Critical Message |
|
| |
|
| sub discrit { |
|
| my $r=shift; |
|
| $r->print('<h1><font color=red>Critical Messages</font></h1>'. |
|
| '<form action=/adm/email method=post>'. |
|
| '<input type=hidden name=confirm value=true>'); |
|
| my %what=&Apache::lonnet::dump('critical'); |
|
| map { |
|
| my %content=&unpackagemsg($what{$_}); |
|
| $content{'message'}=~s/\n/\<br\>/g; |
|
| $r->print('<hr>From: <b>'.$content{'sendername'}.'@'. |
|
| $content{'senderdomain'}.'</b> ('.$content{'time'}. |
|
| ')<br><blockquote>'.$content{'message'}.'</blockquote>'. |
|
| '<input type=submit name="rec_'.$_.'" value="Confirm Receipt">'. |
|
| '<input type=submit name="reprec_'.$_.'" value="Confirm Receipt and Reply">'); |
|
| } sort keys %what; |
|
| $r->print( |
|
| '<input type=hidden name="displayedcrit" value="true"></form>'); |
|
| } |
|
| |
|
| # =============================================================== 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'})) { |
|
| $dispcrit= |
|
| '<input type=checkbox name=critmsg> Send as critical message<p>'; |
|
| } |
|
| $r->print(<<"ENDREPLY"); |
|
| <form action="/adm/email" method=post> |
|
| <input type=hidden name=sendreply value="$msgid"> |
|
| Subject: <input type=text size=50 name=subject value="$subject"><p> |
|
| <textarea name=message cols=60 rows=10> |
|
| $quotemsg |
|
| </textarea><p> |
|
| $dispcrit |
|
| <input type=submit value="Send Reply"> |
|
| </form> |
|
| ENDREPLY |
|
| } |
|
| |
|
| # ======================================================== Display all messages |
|
| |
|
| sub disall { |
|
| my $r=shift; |
|
| $r->print('<h1>Display All Messages</h1>'. |
|
| '<table border=2><tr><th colspan=2> </th><th>Date</th>'. |
|
| '<th>Username</th><th>Domain</th><th>Subject</th><th>Status</th></tr>'); |
|
| map { |
|
| my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)= |
|
| &Apache::lonmsg::unpackmsgid($_); |
|
| unless ($status eq 'deleted') { |
|
| if ($status eq 'new') { |
|
| $r->print('<tr bgcolor="#FFBB77">'); |
|
| } elsif ($status eq 'read') { |
|
| $r->print('<tr bgcolor="#BBBB77">'); |
|
| } elsif ($status eq 'replied') { |
|
| $r->print('<tr bgcolor="#AAAA88">'); |
|
| } else { |
|
| $r->print('<tr bgcolor="#99BBBB">'); |
|
| } |
|
| $r->print('<td><a href="/adm/email?display='.$_. |
|
| '">Open</a></td><td><a href="/adm/email?markdel='.$_. |
|
| '">Delete</a></td><td>'.localtime($sendtime).'</td><td>'. |
|
| $fromname.'</td><td>'.$fromdomain.'</td><td>'. |
|
| &Apache::lonnet::unescape($shortsubj).'</td><td>'. |
|
| $status.'</td></tr>'); |
|
| } |
|
| } sort split(/\&/,&Apache::lonnet::reply('keys:'. |
|
| $ENV{'user.domain'}.':'. |
|
| $ENV{'user.name'}.':nohist_email', |
|
| $ENV{'user.home'})); |
|
| $r->print('</table></body></html>'); |
|
| } |
|
| |
|
| # ============================================================== Compose output |
|
| |
|
| sub compout { |
|
| my ($r,$forwarding)=@_; |
|
| my $dispcrit=''; |
|
| my $dissub=''; |
|
| my $dismsg=''; |
|
| my $func='Send New'; |
|
| if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { |
|
| $dispcrit= |
|
| '<input type=checkbox name=critmsg> Send as critical message<p>'; |
|
| } |
|
| if ($forwarding) { |
|
| $dispcrit.='<input type=hidden name=forwid value="'. |
|
| $forwarding.'">'; |
|
| $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(<<"ENDCOMP"); |
|
| <form action="/adm/email" method=post> |
|
| <input type=hidden name=sendmail value=on> |
|
| <table> |
|
| <tr><td>Username:</td><td><input type=text size=12 name=recuname></td></tr> |
|
| <tr><td>Domain:</td> |
|
| <td><input type=text size=12 name=recdomain value="$defdom"></td></tr> |
|
| <tr><td>Subject:</td><td><input type=text size=50 name=subject value="$dissub"> |
|
| </td></tr></table> |
|
| <textarea name=message cols=60 rows=10>$dismsg |
|
| </textarea><p> |
|
| $dispcrit |
|
| <input type=submit value="$func Mail"> |
|
| </form> |
|
| ENDCOMP |
|
| } |
|
| |
|
| # ===================================================================== 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 'markread') || |
|
| ($name eq 'markdel') || ($name eq 'markunread') || |
|
| ($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 |
=item * B<user_normal_msg($user, $domain, $subject, $message, |
| |
$citation, $baseurl, $attachmenturl)>: Sends a message to the |
| $r->print('<html><head><title>EMail and Messaging</title></head>'); |
$user at $domain, with subject $subject and message $message. |
| $r->print( |
|
| '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
|
| $r->print('<h1>EMail</h1>'); |
|
| 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('<b>Subject:</b> '.$content{'subject'}. |
|
| '<br><b>From:</b> '.$content{'sendername'}.' at '. |
|
| $content{'senderdomain'}. |
|
| '<br><b>Time:</b> '.$content{'time'}.'<p>'. |
|
| '<table border=2><tr bgcolor="#FFFFAA"><td>Functions:</td>'. |
|
| '<td><a href="/adm/email?replyto='.&Apache::lonnet::escape($msgid). |
|
| '"><b>Reply</b></a></td>'. |
|
| '<td><a href="/adm/email?forward='.&Apache::lonnet::escape($msgid). |
|
| '"><b>Forward</b></a></td>'. |
|
| '<td><a href="/adm/email?markunread='.&Apache::lonnet::escape($msgid). |
|
| '"><b>Mark Unread</b></a></td>'. |
|
| '<td><a href="/adm/email"><b>Display all Messages</b></a></td>'. |
|
| '</tr></table><p><pre>'. |
|
| $content{'message'}.'</pre><hr>'.$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'}) && |
|
| (&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'})); |
|
| } |
|
| if ($ENV{'form.displayedcrit'}) { |
|
| &discrit($r); |
|
| } else { |
|
| &disall($r); |
|
| } |
|
| } elsif ($ENV{'form.confirm'}) { |
|
| map { |
|
| if ($_=~/^form\.rec\_(.*)$/) { |
|
| $r->print('<b>Confirming Receipt:</b> '. |
|
| &user_crit_received($1).'<br>'); |
|
| } |
|
| if ($_=~/^form\.reprec\_(.*)$/) { |
|
| my $msgid=$1; |
|
| $r->print('<b>Confirming Receipt:</b> '. |
|
| &user_crit_received($msgid).'<br>'); |
|
| &comprep($r,$msgid); |
|
| } |
|
| } keys %ENV; |
|
| &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.markunread'}) { |
|
| &statuschange($ENV{'form.markunread'},'new'); |
|
| &disall($r); |
|
| } elsif ($ENV{'form.compose'}) { |
|
| &compout($r); |
|
| } 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'}; |
|
| } |
|
| if (($ENV{'form.critmsg'}) && |
|
| (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) { |
|
| $r->print('Sending critical: '. |
|
| &user_crit_msg($ENV{'form.recuname'}, |
|
| $ENV{'form.recdomain'}, |
|
| $ENV{'form.subject'}, |
|
| $ENV{'form.message'}, |
|
| $content{'citation'})); |
|
| } else { |
|
| $r->print('Sending: '.&user_normal_msg($ENV{'form.recuname'}, |
|
| $ENV{'form.recdomain'}, |
|
| $ENV{'form.subject'}, |
|
| $ENV{'form.message'}, |
|
| $content{'citation'})); |
|
| } |
|
| if ($ENV{'form.displayedcrit'}) { |
|
| &discrit($r); |
|
| } else { |
|
| &disall($r); |
|
| } |
|
| } else { |
|
| &disall($r); |
|
| } |
|
| $r->print('</body></html>'); |
|
| return OK; |
|
| |
|
| } |
=cut |
| # ================================================= Main program, reset counter |
|
| |
|
| sub BEGIN { |
sub user_normal_msg { |
| $msgcount=0; |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
| |
$toperm,$sentmessage)=@_; |
| |
my $status=''; |
| |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
| |
$domain,$user); |
| |
my $msgforward=$userenv{'msgforward'}; |
| |
if ($msgforward) { |
| |
foreach (split(/\,/,$msgforward)) { |
| |
my ($forwuser,$forwdomain)=split(/\:/,$_); |
| |
$status.= |
| |
&user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, |
| |
$citation,$baseurl,$attachmenturl,$toperm, |
| |
undef,undef,$sentmessage).' '; |
| |
} |
| |
} else { |
| |
$status=&user_normal_msg_raw($user,$domain,$subject,$message, |
| |
$citation,$baseurl,$attachmenturl,$toperm, |
| |
undef,undef,$sentmessage); |
| |
} |
| |
return $status; |
| } |
} |
| |
|
| 1; |
sub store_sent_mail { |
| __END__ |
my ($msgid,$message) = @_; |
| |
my $status =' '.&Apache::lonnet::critical( |
| |
'put:'.$env{'user.domain'}.':'.$env{'user.name'}. |
| |
':nohist_email_sent:'. |
| |
&escape($msgid).'='. |
| |
&escape($message),$env{'user.home'}); |
| |
return $status; |
| |
} |
| |
|
| |
# =============================================================== Folder suffix |
| |
|
| |
sub foldersuffix { |
| |
my $folder=shift; |
| |
unless ($folder) { return ''; } |
| |
return '_'.&escape($folder); |
| |
} |
| |
|
| |
1; |
| |
__END__ |
| |
|
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmsg.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface