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

release-1.8release-1.9
Last change on this file since 8d553bf was 8d553bf, checked in by David Benjamin <davidben@mit.edu>, 11 years ago
Append sender's realm to Cc'd unqualified names when replying Currently, if you reply to a personal from a user in another realm, that message was Cc'd to other people on their realm, and the sender didn't specify their realm, Barnowl will try to Cc the message to users of the same name in your realm. So, if you are 'bar@EXAMPLE.ORG' and you get a message from 'foo@EXAMPLE.COM' cc'd to 'bletch', if you try to reply, Barnowl will address it to foo@EXAMPLE.COM, cc'd to 'bletch', which would be bletch@EXAMPLE.ORG, which is clearly wrong. This patch appends the sender's realm to unqualified names in the message's Cc line when generating the reply zwrite command line. [davidben@mit.edu: Fix up some edge case handling]
  • Property mode set to 100644
File size: 5.6 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        $to = $self->recipient;
174        $cc = $self->zephyr_cc();
175        if($to eq '*' || $to eq '') {
176            $to = '';
177        } elsif($to !~ /^@/) {
178            $to = $self->sender;
179        }
180    }
181
182    my @cmd;
183    if(lc $self->opcode eq 'crypt' and ( not $sender or $self->is_private)) {
184        # Responses to zcrypted messages should be zcrypted, so long as we
185        # aren't switching to personals
186        @cmd = ('zcrypt');
187    } else {
188        @cmd = ('zwrite');
189    }
190
191    push @cmd, context_reply_cmd($class, $instance);
192
193    if ($to ne '') {
194        $to = strip_realm($to);
195        if (defined $cc and not $sender) {
196            my @cc = grep /^[^-]/, ($to, split /\s+/, $cc);
197            my %cc = map {$_ => 1} @cc;
198            # this isn't quite right - it doesn't strip off the
199            # user if the message was addressed to them by fully qualified
200            # name
201            delete $cc{strip_realm(BarnOwl::zephyr_getsender())};
202            @cc = keys %cc;
203
204            my $sender_realm = principal_realm($self->sender);
205            if (BarnOwl::zephyr_getrealm() ne $sender_realm) {
206                @cc = map {
207                    if($_ !~ /@/) {
208                       "${_}\@${sender_realm}";
209                    } else {
210                        $_;
211                    }
212                } @cc;
213            }
214            push @cmd, '-C', @cc;
215        } else {
216            if(BarnOwl::getvar('smartstrip') eq 'on') {
217                $to = BarnOwl::zephyr_smartstrip_user($to);
218            }
219            push @cmd, $to;
220        }
221    }
222    return BarnOwl::quote(@cmd);
223}
224
225sub replysendercmd {
226    my $self = shift;
227    return $self->replycmd(1);
228}
229
230
2311;
Note: See TracBrowser for help on using the repository browser.