source: perl/lib/BarnOwl/Message/Zephyr.pm @ 5738650

release-1.8release-1.9
Last change on this file since 5738650 was edd0be7, checked in by David Benjamin <davidben@mit.edu>, 11 years ago
Only handle CCs in messages sent directly to you. A zephyr with a CC line received on @SOME-REALM would still handle the CC logic in replycmd. This oddity could possibly be retrofited to allow @SOME-REALM to participate in CC'd messages, but that would require us to handle CC lines on messages received on *. In the meantime, let's not leave a half-baked not-feature. Also refactor the block slightly. The original formulation is confusing; it means to condition on the recipient of the message we reply to, but actually checks $to, the recipient we use in the reply. It just happens that in one case, the two are equal. The original code would assume that case and then change its mind if it was wrong.
  • Property mode set to 100644
File size: 5.7 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 login_type {
26    return (shift->zsig eq "") ? "(PSEUDO)" : "";
27}
28
29sub login_extra {
30    my $m = shift;
31    return undef if (!$m->is_loginout);
32    my $s = lc($m->host);
33    $s .= " " . $m->login_tty if defined $m->login_tty;
34    return $s;
35}
36
37sub long_sender {
38    my $m = shift;
39    return $m->zsig;
40}
41
42sub context {
43    return shift->class;
44}
45
46sub subcontext {
47    return shift->instance;
48}
49
50sub login_tty {
51    my ($m) = @_;
52    return undef if (!$m->is_loginout);
53    return $m->fields->[2];
54}
55
56sub login_host {
57    my ($m) = @_;
58    return undef if (!$m->is_loginout);
59    return $m->fields->[0];
60}
61
62sub zwriteline  { return shift->{"zwriteline"}; }
63
64sub is_ping     { return (lc(shift->opcode) eq "ping"); }
65
66sub is_personal {
67    my ($m) = @_;
68    return ((lc($m->class) eq "message")
69            && $m->is_private);
70}
71
72sub is_mail {
73    my ($m) = @_;
74    return ((lc($m->class) eq "mail") && $m->is_private);
75}
76
77sub pretty_sender {
78    my ($m) = @_;
79    return strip_realm($m->sender);
80}
81
82sub pretty_recipient {
83    my ($m) = @_;
84    return strip_realm($m->recipient);
85}
86
87# Portion of the reply command that preserves the context
88sub context_reply_cmd {
89    my $mclass = shift;
90    my $minstance = shift;
91    my @class;
92    if (lc($mclass) ne "message") {
93        @class = ('-c', $mclass);
94    }
95    my @instance;
96    if (lc($minstance) ne "personal") {
97        @instance = ('-i', $minstance);
98    }
99    return (@class, @instance);
100}
101
102sub personal_context {
103    my ($m) = @_;
104    return BarnOwl::quote(context_reply_cmd($m->class, $m->instance));
105}
106
107sub short_personal_context {
108    my ($m) = @_;
109    if(lc($m->class) eq 'message')
110    {
111        if(lc($m->instance) eq 'personal')
112        {
113            return '';
114        } else {
115            return $m->instance;
116        }
117    } else {
118        return $m->class;
119    }
120}
121
122# These are arguably zephyr-specific
123sub class       { return shift->{"class"}; }
124sub instance    { return shift->{"instance"}; }
125sub realm       { return shift->{"realm"}; }
126sub opcode      { return shift->{"opcode"}; }
127sub host        { return shift->{"hostname"}; }
128sub hostname    { return shift->{"hostname"}; }
129sub header      { return shift->{"header"}; }
130sub auth        { return shift->{"auth"}; }
131sub fields      { return shift->{"fields"}; }
132sub zsig        { return shift->{"zsig"}; }
133
134sub zephyr_cc {
135    my $self = shift;
136    return $1 if $self->body =~ /^\s*cc:\s+([^\n]+)/i;
137    return undef;
138}
139
140sub replycmd {
141    my $self = shift;
142    my $sender = shift;
143    $sender = 0 unless defined $sender;
144    my ($class, $instance, $to, $cc);
145    if($self->is_outgoing) {
146        return $self->{zwriteline};
147    }
148
149    if($sender && $self->opcode eq WEBZEPHYR_OPCODE) {
150        $class = WEBZEPHYR_CLASS;
151        $instance = $self->pretty_sender;
152        $instance =~ s/-webzephyr$//;
153        $to = WEBZEPHYR_PRINCIPAL;
154    } elsif($self->class eq WEBZEPHYR_CLASS
155            && $self->is_loginout) {
156        $class = WEBZEPHYR_CLASS;
157        $instance = $self->instance;
158        $to = WEBZEPHYR_PRINCIPAL;
159    } elsif($self->is_loginout) {
160        $class = 'MESSAGE';
161        $instance = 'PERSONAL';
162        $to = $self->sender;
163    } elsif($sender && !$self->is_private) {
164        # Possible future feature: (Optionally?) include the class and/or
165        # instance of the message being replied to in the instance of the
166        # outgoing personal reply
167        $class = 'MESSAGE';
168        $instance = 'PERSONAL';
169        $to = $self->sender;
170    } else {
171        $class = $self->class;
172        $instance = $self->instance;
173        if ($self->recipient eq '*' || $self->recipient eq '') {
174            $to = '';
175        } elsif ($self->recipient =~ /^@/) {
176            $to = $self->recipient;
177        } else {
178            $to = $self->sender;
179            $cc = $self->zephyr_cc();
180        }
181    }
182
183    my @cmd;
184    if(lc $self->opcode eq 'crypt' and ( not $sender or $self->is_private)) {
185        # Responses to zcrypted messages should be zcrypted, so long as we
186        # aren't switching to personals
187        @cmd = ('zcrypt');
188    } else {
189        @cmd = ('zwrite');
190    }
191
192    push @cmd, context_reply_cmd($class, $instance);
193
194    if ($to ne '') {
195        $to = strip_realm($to);
196        if (defined $cc and not $sender) {
197            my @cc = grep /^[^-]/, ($to, split /\s+/, $cc);
198            my %cc = map {$_ => 1} @cc;
199            # this isn't quite right - it doesn't strip off the
200            # user if the message was addressed to them by fully qualified
201            # name
202            delete $cc{strip_realm(BarnOwl::zephyr_getsender())};
203            @cc = keys %cc;
204
205            my $sender_realm = principal_realm($self->sender);
206            if (BarnOwl::zephyr_getrealm() ne $sender_realm) {
207                @cc = map {
208                    if($_ !~ /@/) {
209                       "${_}\@${sender_realm}";
210                    } else {
211                        $_;
212                    }
213                } @cc;
214            }
215            push @cmd, '-C', @cc;
216        } else {
217            if(BarnOwl::getvar('smartstrip') eq 'on') {
218                $to = BarnOwl::zephyr_smartstrip_user($to);
219            }
220            push @cmd, $to;
221        }
222    }
223    return BarnOwl::quote(@cmd);
224}
225
226sub replysendercmd {
227    my $self = shift;
228    return $self->replycmd(1);
229}
230
231
2321;
Note: See TracBrowser for help on using the repository browser.