source: perl/lib/BarnOwl/Message/Zephyr.pm @ 8f91a70

Last change on this file since 8f91a70 was 8f91a70, checked in by Jason Gross <jasongross9@gmail.com>, 7 years ago
Add a bit more documentation The function was potentially a bit confusing under code review.
  • Property mode set to 100644
File size: 7.9 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Message::Zephyr;
5
6use constant WEBZEPHYR_PRINCIPAL => "daemon/webzephyr.mit.edu";
7use constant WEBZEPHYR_CLASS     => "webzephyr";
8use constant WEBZEPHYR_OPCODE    => "webzephyr";
9
10use base qw( BarnOwl::Message );
11
12sub strip_realm {
13    my $sender = shift;
14    my $realm = BarnOwl::zephyr_getrealm();
15    $sender =~ s/\@\Q$realm\E$//;
16    return $sender;
17}
18
19sub principal_realm {
20    my $principal = shift;
21    my ($user, $realm) = split(/@/,$principal);
22    return $realm;
23}
24
25sub casefold_principal {
26    my $principal = shift;
27    # split the principal right after the final @, without eating any
28    # characters; this way, we always get at least '@' in $user
29    my ($user, $realm) = split(/(?<=@)(?=[^@]+$)/, $principal);
30    $user = '' if !defined $user;
31    $user = lc($user);
32    $user = $user . uc($realm) if defined $realm;
33    return $user;
34}
35
36sub login_type {
37    return (shift->zsig eq "") ? "(PSEUDO)" : "";
38}
39
40sub login_extra {
41    my $m = shift;
42    return undef if (!$m->is_loginout);
43    my $s = lc($m->host);
44    $s .= " " . $m->login_tty if defined $m->login_tty;
45    return $s;
46}
47
48sub long_sender {
49    my $m = shift;
50    return $m->zsig;
51}
52
53sub context {
54    return shift->class;
55}
56
57sub subcontext {
58    return shift->instance;
59}
60
61sub login_tty {
62    my ($m) = @_;
63    return undef if (!$m->is_loginout);
64    return undef if (!defined($m->fields));
65    return $m->fields->[2];
66}
67
68sub login_host {
69    my ($m) = @_;
70    return undef if (!$m->is_loginout);
71    return undef if (!defined($m->fields));
72    return $m->fields->[0];
73}
74
75sub zwriteline  { return shift->{"zwriteline"}; }
76
77sub is_ping     { return (lc(shift->opcode) eq "ping"); }
78
79sub is_mail {
80    my ($m) = @_;
81    return ((lc($m->class) eq "mail") && $m->is_private);
82}
83
84sub pretty_sender {
85    my ($m) = @_;
86    return strip_realm($m->sender);
87}
88
89sub pretty_recipient {
90    my ($m) = @_;
91    return strip_realm($m->recipient);
92}
93
94# Portion of the reply command that preserves the context
95sub context_reply_cmd {
96    my $mclass = shift;
97    my $minstance = shift;
98    my @class;
99    if (lc($mclass) ne "message") {
100        @class = ('-c', $mclass);
101    }
102    my @instance;
103    if (lc($minstance) ne "personal") {
104        @instance = ('-i', $minstance);
105    }
106    return (@class, @instance);
107}
108
109sub personal_context {
110    my ($m) = @_;
111    return BarnOwl::quote(context_reply_cmd($m->class, $m->instance));
112}
113
114sub short_personal_context {
115    my ($m) = @_;
116    if(lc($m->class) eq 'message')
117    {
118        if(lc($m->instance) eq 'personal')
119        {
120            return '';
121        } else {
122            return $m->instance;
123        }
124    } else {
125        return $m->class;
126    }
127}
128
129# These are arguably zephyr-specific
130sub class       { return shift->{"class"}; }
131sub instance    { return shift->{"instance"}; }
132sub realm       { return shift->{"realm"}; }
133sub opcode      { return shift->{"opcode"}; }
134sub host        { return shift->{"hostname"}; }
135sub hostname    { return shift->{"hostname"}; }
136sub header      { return shift->{"header"}; }
137sub auth        { return shift->{"auth"}; }
138sub fields      { return shift->{"fields"}; }
139sub zsig        { return shift->{"zsig"}; }
140
141sub zephyr_cc {
142    my $self = shift;
143    return $1 if $self->body =~ /^\s*cc:\s+([^\n]+)/i;
144    return undef;
145}
146
147# Note: This is the cc-line without the recipient; it does not include
148# the sender.
149sub zephyr_cc_without_recipient {
150    my $self = shift;
151    my $recipient = lc(strip_realm($self->recipient));
152    my $cc = $self->zephyr_cc;
153    return grep { lc(strip_realm($_)) ne $recipient } split(/\s+/, $cc) if defined $cc;
154    return ();
155}
156
157sub replycmd {
158    my $self = shift;
159    my $sender = shift;
160    $sender = 0 unless defined $sender;
161    my ($class, $instance, $to, $cc);
162    if($self->is_outgoing) {
163        return $self->{zwriteline};
164    }
165
166    if($sender && $self->opcode eq WEBZEPHYR_OPCODE) {
167        $class = WEBZEPHYR_CLASS;
168        $instance = $self->pretty_sender;
169        $instance =~ s/-webzephyr$//;
170        $to = WEBZEPHYR_PRINCIPAL;
171    } elsif($self->class eq WEBZEPHYR_CLASS
172            && $self->is_loginout) {
173        $class = WEBZEPHYR_CLASS;
174        $instance = $self->instance;
175        $to = WEBZEPHYR_PRINCIPAL;
176    } elsif($self->is_loginout) {
177        $class = 'MESSAGE';
178        $instance = 'PERSONAL';
179        $to = $self->sender;
180    } elsif($sender && !$self->is_private) {
181        # Possible future feature: (Optionally?) include the class and/or
182        # instance of the message being replied to in the instance of the
183        # outgoing personal reply
184        $class = 'MESSAGE';
185        $instance = 'PERSONAL';
186        $to = $self->sender;
187    } else {
188        $class = $self->class;
189        $instance = $self->instance;
190        if ($self->recipient eq '' || $self->recipient =~ /^@/) {
191            $to = $self->recipient;
192        } else {
193            $to = $self->sender;
194            $cc = $self->zephyr_cc();
195        }
196    }
197
198    my @cmd;
199    if(lc $self->opcode eq 'crypt' and ( not $sender or $self->is_private)) {
200        # Responses to zcrypted messages should be zcrypted, so long as we
201        # aren't switching to personals
202        @cmd = ('zcrypt');
203    } else {
204        @cmd = ('zwrite');
205    }
206
207    push @cmd, context_reply_cmd($class, $instance);
208
209    if ($to ne '') {
210        $to = strip_realm($to);
211        if (defined $cc and not $sender) {
212            my @cc = grep /^[^-]/, ($to, split /\s+/, $cc);
213            my %cc = map {$_ => 1} @cc;
214            # this isn't quite right - it doesn't strip off the
215            # user if the message was addressed to them by fully qualified
216            # name
217            delete $cc{strip_realm(BarnOwl::zephyr_getsender())};
218            @cc = keys %cc;
219
220            my $sender_realm = principal_realm($self->sender);
221            if (BarnOwl::zephyr_getrealm() ne $sender_realm) {
222                @cc = map {
223                    if($_ !~ /@/) {
224                       "${_}\@${sender_realm}";
225                    } else {
226                        $_;
227                    }
228                } @cc;
229            }
230            push @cmd, '-C', @cc;
231        } else {
232            if(BarnOwl::getvar('smartstrip') eq 'on') {
233                $to = BarnOwl::zephyr_smartstrip_user($to);
234            }
235            push @cmd, $to;
236        }
237    }
238    return BarnOwl::quote(@cmd);
239}
240
241sub replysendercmd {
242    my $self = shift;
243    return $self->replycmd(1);
244}
245
246# Logging
247sub log_header {
248    my ($m) = @_;
249    my $class = $m->class;
250    my $instance = $m->instance;
251    my $opcode = $m->opcode;
252    my $timestr = $m->time;
253    my $host = $m->host;
254    my $sender = $m->pretty_sender;
255    my $zsig = $m->zsig;
256    my $rtn = "Class: $class Instance: $instance";
257    $rtn .= " Opcode: $opcode" unless !defined $opcode || $opcode eq '';
258    $rtn .= "\nTime: $timestr Host: $host"
259          . "\nFrom: $zsig <$sender>";
260    return $rtn;
261}
262
263sub log_filenames {
264    my ($m) = @_;
265    my @filenames = ();
266    if ($m->is_personal) {
267        # If this has CC's, add all but the "recipient" which we'll add below
268        @filenames = $m->zephyr_cc_without_recipient;
269    }
270    if ($m->is_incoming) {
271        if ($m->is_personal) {
272            push @filenames, $m->sender;
273        } else {
274            my $realm = '';
275            $realm .= '@' . $m->realm if $m->realm ne BarnOwl::zephyr_getrealm();
276            return (BarnOwl::compat_casefold($m->class) . uc($realm));
277        }
278    } else {
279        push @filenames, $m->recipient;
280    }
281    return map { casefold_principal(BarnOwl::zephyr_smartstrip_user(strip_realm($_))) } @filenames;
282}
283
284sub log_to_class_file {
285    my ($m) = @_;
286    return !$m->is_personal;
287}
288
289sub log_path {
290    my ($m) = @_;
291    if ($m->log_to_class_file) {
292        return BarnOwl::getvar('classlogpath');
293    } else {
294        return BarnOwl::getvar('logpath');
295    }
296}
297
298sub should_log {
299    my ($m) = @_;
300    if ($m->log_to_class_file) {
301        return BarnOwl::getvar('classlogging') eq 'on';
302    } else {
303        return BarnOwl::getvar('logging') eq 'on';
304    }
305}
306
3071;
Note: See TracBrowser for help on using the repository browser.