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