Annotation of loncom/interface/lonmsg.pm, revision 1.6
1.1 www 1: # The LearningOnline Network with CAPA
2: #
3: # Routines for messaging
4: #
5: # (Routines to control the menu
6: #
7: # (TeX Conversion Module
8: #
9: # 05/29/00,05/30 Gerd Kortemeyer)
10: #
11: # 10/05 Gerd Kortemeyer)
12: #
1.6 ! www 13: # 10/19,10/20,10/30,
! 14: # 02/06/01 Gerd Kortemeyer
1.1 www 15:
16: package Apache::lonmsg;
17:
18: use strict;
19: use Apache::lonnet();
1.2 www 20: use vars qw($msgcount);
21: use HTML::TokeParser;
1.5 www 22: use Apache::Constants qw(:common);
1.1 www 23:
24: # ===================================================================== Package
25:
1.3 www 26: sub packagemsg {
27: my ($subject,$message)=@_;
1.1 www 28: $message=~s/\</\<\;/g;
29: $message=~s/\>/\>\;/g;
30: $subject=~s/\</\<\;/g;
31: $subject=~s/\>/\>\;/g;
1.2 www 32: my $now=time;
33: $msgcount++;
1.6 ! www 34: my $partsubj=$subject;
! 35: $partsubj=&Apache::lonnet::escape($partsubj);
! 36: $partsubj=substr($partsubj,0,50);
! 37: my $msgid=&Apache::lonnet::escape(
! 38: $now.':'.$partsubj.':'.$ENV{'user.name'}.':'.
! 39: $ENV{'user.domain'}.':'.$msgcount.':'.$$);
1.2 www 40: return $msgid,
41: '<sendername>'.$ENV{'user.name'}.'</sendername>'.
1.1 www 42: '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
43: '<subject>'.$subject.'</subject>'.
1.2 www 44: '<time>'.localtime($now).'</time>'.
1.1 www 45: '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
46: '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
47: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
48: '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.
49: '<browseros>'.$ENV{'browser.os'}.'</browseros>'.
50: '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.
51: '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.
52: '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
53: '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
54: '<role>'.$ENV{'request.role'}.'</role>'.
55: '<resource>'.$ENV{'request.filename'}.'</resource>'.
1.2 www 56: '<msgid>'.$msgid.'</msgid>'.
1.1 www 57: '<message>'.$message.'</message>';
58: }
59:
1.2 www 60: # ================================================== Unpack message into a hash
61:
1.3 www 62: sub unpackagemsg {
1.2 www 63: my $message=shift;
64: my %content=();
65: my $parser=HTML::TokeParser->new(\$message);
66: my $token;
67: while ($token=$parser->get_token) {
68: if ($token->[0] eq 'S') {
69: my $entry=$token->[1];
70: my $value=$parser->get_text('/'.$entry);
71: $content{$entry}=$value;
72: }
73: }
74: return %content;
75: }
76:
1.6 ! www 77: # ======================================================= Get info out of msgid
! 78:
! 79: sub unpackmsgid {
! 80: my $msgid=shift;
! 81: my ($sendtime,$shortsubj,$fromname,$fromdomain)=split(/\:/,
! 82: &Apache::lonnet::unescape(
! 83: &Apache::lonnet::unescape($_)));
! 84: my %status=&Apache::lonnet::get('email_status',$msgid);
! 85: if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
! 86: unless ($status{$msgid}) { $status{$msgid}='new'; }
! 87: return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid});
! 88: }
! 89:
1.1 www 90: # =============================== Automated message to the author of a resource
91:
92: sub author_res_msg {
93: my ($filename,$message)=@_;
1.2 www 94: unless ($message) { return 'empty'; }
1.1 www 95: $filename=&Apache::lonnet::declutter($filename);
96: my ($domain,$author,@dummy)=split(/\//,$filename);
97: my $homeserver=&Apache::lonnet::homeserver($author,$domain);
98: if ($homeserver ne 'no_host') {
99: my $id=unpack("%32C*",$message);
1.2 www 100: my $msgid;
1.3 www 101: ($msgid,$message)=&packagemsg($filename,$message);
102: return &Apache::lonnet::reply('put:'.$domain.':'.$author.
103: ':nohist_res_msgs:'.
104: &Apache::lonnet::escape($filename.'_'.$id).'='.
105: &Apache::lonnet::escape($message),$homeserver);
1.1 www 106: }
1.2 www 107: return 'no_host';
1.1 www 108: }
109:
110: # ================================================== Critical message to a user
111:
112: sub user_crit_msg {
113: my ($user,$domain,$subject,$message)=@_;
1.2 www 114: # Check if allowed missing
115: my $status='';
116: my $msgid='undefined';
117: unless (($message)&&($user)&&($domain)) { $status='empty'; };
118: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
119: if ($homeserver ne 'no_host') {
120: my $msgid;
1.3 www 121: ($msgid,$message)=&packagemsg($subject,$message);
1.4 www 122: $status=&Apache::lonnet::critical(
123: 'put:'.$domain.':'.$user.':critical:'.
124: &Apache::lonnet::escape($msgid).'='.
125: &Apache::lonnet::escape($message),$homeserver);
1.2 www 126: } else {
127: $status='no_host';
128: }
129: &Apache::lonnet::logthis(
1.4 www 130: 'Sending critical email '.$msgid.
1.2 www 131: ', log status: '.
132: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
133: $ENV{'user.home'},
134: 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
1.4 www 135: .$status));
1.2 www 136: return $status;
137: }
138:
139: # =================================================== Critical message received
140:
141: sub user_crit_received {
142: my $message=shift;
1.4 www 143: my %contents=&unpackagemsg($message);
1.5 www 144: my $status='rec: '.
145: &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
1.4 www 146: 'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},
147: 'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
148: ' acknowledged receipt of message "'.
149: $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n"
150: .'Message ID: '.$contents{'msgid'});
1.5 www 151: $status.=' trans: '.
152: &Apache::lonnet::put('nohist_email',$contents{'msgid'} => $message);
153: $status.=' del: '.
154: &Apache::lonnet::del('critical',$contents{'msgid'});
155: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
156: $ENV{'user.home'},'Received critical message '.
157: $contents{'msgid'}.
158: ', '.$status);
1.2 www 159: }
160:
161: # ======================================================== Normal communication
162:
163: sub user_normal_msg {
164: my ($user,$domain,$subject,$message)=@_;
165: # Check if allowed missing
166: my $status='';
167: my $msgid='undefined';
168: unless (($message)&&($user)&&($domain)) { $status='empty'; };
169: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
170: if ($homeserver ne 'no_host') {
171: my $msgid;
1.3 www 172: ($msgid,$message)=&packagemsg($subject,$message);
1.4 www 173: $status=&Apache::lonnet::critical(
174: 'put:'.$domain.':'.$user.':nohist_email:'.
175: &Apache::lonnet::escape($msgid).'='.
176: &Apache::lonnet::escape($message),$homeserver);
1.2 www 177: } else {
178: $status='no_host';
179: }
180: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
181: $ENV{'user.home'},
182: 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
183: return $status;
184: }
185:
1.5 www 186: # ===================================================================== Handler
187:
188: sub handler {
189: my $r=shift;
190:
191: # ----------------------------------------------------------- Set document type
192:
193: $r->content_type('text/html');
194: $r->send_http_header;
195:
196: return OK if $r->header_only;
197:
1.6 ! www 198: # --------------------------- Get query string for limited number of parameters
! 199:
! 200: map {
! 201: my ($name, $value) = split(/=/,$_);
! 202: $value =~ tr/+/ /;
! 203: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
! 204: if (($name eq 'display') || ($name eq 'replyto') ||
! 205: ($name eq 'forward') || ($name eq 'mark')) {
! 206: unless ($ENV{'form.'.$name}) {
! 207: $ENV{'form.'.$name}=$value;
! 208: }
! 209: }
! 210: } (split(/&/,$ENV{'QUERY_STRING'}));
! 211:
1.5 www 212: # --------------------------------------------------------------- Render Output
213:
214: $r->print('<html><head><title>EMail and Messaging</title></head>');
215: $r->print('<body bgcolor="#FFFFFF">');
216: $r->print('<h1>EMail</h1>');
1.6 ! www 217: if ($ENV{'form.display'}) {
! 218: } elsif ($ENV{'form.replyto'}) {
! 219: } elsif ($ENV{'form.forward'}) {
! 220: } elsif ($ENV{'form.mark'}) {
! 221: } else {
! 222: $r->print('<table border=2><tr><th> </th><th>Date</th>'.
! 223: '<th>Username</th><th>Domain</th><th>Subject</th><th>Status</th></tr>');
! 224: map {
! 225: my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)=
! 226: &Apache::lonmsg::unpackmsgid($_);
! 227: if ($status eq 'new') {
! 228: $r->print('<tr bgcolor="#FFBB77">');
! 229: } elsif ($status eq 'read') {
! 230: $r->print('<tr bgcolor="#BBBB77">');
! 231: } elsif ($status eq 'replied') {
! 232: $r->print('<tr bgcolor="#BBBB99">');
! 233: } else {
! 234: $r->print('<tr bgcolor="#99BBBB">');
! 235: }
! 236: $r->print('<td><a href="/adm/email?display='.$_.
! 237: '">Open</a></td><td>'.localtime($sendtime).'</td><td>'.
! 238: $fromname.'</td><td>'.$fromdomain.'</td><td>'.
! 239: &Apache::lonnet::unescape($shortsubj).'</td><td>'.
! 240: $status.'</td></tr>');
! 241: } sort split(/\&/,&Apache::lonnet::reply('keys:'.
! 242: $ENV{'user.domain'}.':'.
! 243: $ENV{'user.name'}.':nohist_email',
! 244: $ENV{'user.home'}));
! 245: $r->print('</table></body></html>');
! 246:
! 247: }
1.5 www 248: $r->print('</body></html>');
249: return OK;
250:
251: }
1.2 www 252: # ================================================= Main program, reset counter
253:
254: sub BEGIN {
255: $msgcount=0;
1.1 www 256: }
257:
258: 1;
259: __END__
260:
261:
262:
263:
264:
265:
266:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[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