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: #
13: # 10/19,10/20,10/30 Gerd Kortemeyer
14:
15: package Apache::lonmsg;
16:
17: use strict;
18: use Apache::lonnet();
19: use vars qw($msgcount);
20: use HTML::TokeParser;
21: use Apache::Constants qw(:common);
22:
23: # ===================================================================== Package
24:
25: sub packagemsg {
26: my ($subject,$message)=@_;
27: $message=~s/\</\<\;/g;
28: $message=~s/\>/\>\;/g;
29: $subject=~s/\</\<\;/g;
30: $subject=~s/\>/\>\;/g;
31: my $now=time;
32: $msgcount++;
33: my $msgid=$now.'_'.$ENV{'user.name'}.'_'.
34: $ENV{'user.domain'}.'_'.$msgcount.'_'.$$;
35: return $msgid,
36: '<sendername>'.$ENV{'user.name'}.'</sendername>'.
37: '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
38: '<subject>'.$subject.'</subject>'.
39: '<time>'.localtime($now).'</time>'.
40: '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
41: '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
42: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
43: '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.
44: '<browseros>'.$ENV{'browser.os'}.'</browseros>'.
45: '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.
46: '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.
47: '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
48: '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
49: '<role>'.$ENV{'request.role'}.'</role>'.
50: '<resource>'.$ENV{'request.filename'}.'</resource>'.
51: '<msgid>'.$msgid.'</msgid>'.
52: '<message>'.$message.'</message>';
53: }
54:
55: # ================================================== Unpack message into a hash
56:
57: sub unpackagemsg {
58: my $message=shift;
59: my %content=();
60: my $parser=HTML::TokeParser->new(\$message);
61: my $token;
62: while ($token=$parser->get_token) {
63: if ($token->[0] eq 'S') {
64: my $entry=$token->[1];
65: my $value=$parser->get_text('/'.$entry);
66: $content{$entry}=$value;
67: }
68: }
69: return %content;
70: }
71:
72: # =============================== Automated message to the author of a resource
73:
74: sub author_res_msg {
75: my ($filename,$message)=@_;
76: unless ($message) { return 'empty'; }
77: $filename=&Apache::lonnet::declutter($filename);
78: my ($domain,$author,@dummy)=split(/\//,$filename);
79: my $homeserver=&Apache::lonnet::homeserver($author,$domain);
80: if ($homeserver ne 'no_host') {
81: my $id=unpack("%32C*",$message);
82: my $msgid;
83: ($msgid,$message)=&packagemsg($filename,$message);
84: return &Apache::lonnet::reply('put:'.$domain.':'.$author.
85: ':nohist_res_msgs:'.
86: &Apache::lonnet::escape($filename.'_'.$id).'='.
87: &Apache::lonnet::escape($message),$homeserver);
88: }
89: return 'no_host';
90: }
91:
92: # ================================================== Critical message to a user
93:
94: sub user_crit_msg {
95: my ($user,$domain,$subject,$message)=@_;
96: # Check if allowed missing
97: my $status='';
98: my $msgid='undefined';
99: unless (($message)&&($user)&&($domain)) { $status='empty'; };
100: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
101: if ($homeserver ne 'no_host') {
102: my $msgid;
103: ($msgid,$message)=&packagemsg($subject,$message);
104: $status=&Apache::lonnet::critical(
105: 'put:'.$domain.':'.$user.':critical:'.
106: &Apache::lonnet::escape($msgid).'='.
107: &Apache::lonnet::escape($message),$homeserver);
108: } else {
109: $status='no_host';
110: }
111: &Apache::lonnet::logthis(
112: 'Sending critical email '.$msgid.
113: ', log status: '.
114: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
115: $ENV{'user.home'},
116: 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
117: .$status));
118: return $status;
119: }
120:
121: # =================================================== Critical message received
122:
123: sub user_crit_received {
124: my $message=shift;
125: my %contents=&unpackagemsg($message);
126: my $status='rec: '.
127: &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
128: 'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},
129: 'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
130: ' acknowledged receipt of message "'.
131: $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n"
132: .'Message ID: '.$contents{'msgid'});
133: $status.=' trans: '.
134: &Apache::lonnet::put('nohist_email',$contents{'msgid'} => $message);
135: $status.=' del: '.
136: &Apache::lonnet::del('critical',$contents{'msgid'});
137: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
138: $ENV{'user.home'},'Received critical message '.
139: $contents{'msgid'}.
140: ', '.$status);
141: }
142:
143: # ======================================================== Normal communication
144:
145: sub user_normal_msg {
146: my ($user,$domain,$subject,$message)=@_;
147: # Check if allowed missing
148: my $status='';
149: my $msgid='undefined';
150: unless (($message)&&($user)&&($domain)) { $status='empty'; };
151: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
152: if ($homeserver ne 'no_host') {
153: my $msgid;
154: ($msgid,$message)=&packagemsg($subject,$message);
155: $status=&Apache::lonnet::critical(
156: 'put:'.$domain.':'.$user.':nohist_email:'.
157: &Apache::lonnet::escape($msgid).'='.
158: &Apache::lonnet::escape($message),$homeserver);
159: } else {
160: $status='no_host';
161: }
162: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
163: $ENV{'user.home'},
164: 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
165: return $status;
166: }
167:
168: # ===================================================================== Handler
169:
170: sub handler {
171: my $r=shift;
172:
173: # ----------------------------------------------------------- Set document type
174:
175: $r->content_type('text/html');
176: $r->send_http_header;
177:
178: return OK if $r->header_only;
179:
180: # --------------------------------------------------------------- Render Output
181:
182: $r->print('<html><head><title>EMail and Messaging</title></head>');
183: $r->print('<body bgcolor="#FFFFFF">');
184: $r->print('<h1>EMail</h1>');
185: $r->print('</body></html>');
186: return OK;
187:
188: }
189: # ================================================= Main program, reset counter
190:
191: sub BEGIN {
192: $msgcount=0;
193: }
194:
195: 1;
196: __END__
197:
198:
199:
200:
201:
202:
203:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>