source: perl/lib/BarnOwl/Message/Zephyr.pm @ 3ff3d86

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 3ff3d86 was 30e7ffd, checked in by Alex Dehnert <adehnert@mit.edu>, 15 years ago
Don't zcrypt shift-R replies to zcrypted messages In particular, if we've set $sender to force a recipient, and the original message was not private, then we won't use zcrypt.
  • Property mode set to 100644
File size: 5.2 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Message::Zephyr;
5
6use constant WEBZEPHYR_PRINCIPAL => "daemon.webzephyr";
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/\@$realm$//;
16    return $sender;
17}
18
19sub login_type {
20    return (shift->zsig eq "") ? "(PSEUDO)" : "";
21}
22
23sub login_extra {
24    my $m = shift;
25    return undef if (!$m->is_loginout);
26    my $s = lc($m->host);
27    $s .= " " . $m->login_tty if defined $m->login_tty;
28    return $s;
29}
30
31sub long_sender {
32    my $m = shift;
33    return $m->zsig;
34}
35
36sub context {
37    return shift->class;
38}
39
40sub subcontext {
41    return shift->instance;
42}
43
44sub login_tty {
45    my ($m) = @_;
46    return undef if (!$m->is_loginout);
47    return $m->fields->[2];
48}
49
50sub login_host {
51    my ($m) = @_;
52    return undef if (!$m->is_loginout);
53    return $m->fields->[0];
54}
55
56sub zwriteline  { return shift->{"zwriteline"}; }
57
58sub is_ping     { return (lc(shift->opcode) eq "ping"); }
59
60sub is_personal {
61    my ($m) = @_;
62    return ((lc($m->class) eq "message")
63            && $m->is_private);
64}
65
66sub is_mail {
67    my ($m) = @_;
68    return ((lc($m->class) eq "mail") && $m->is_private);
69}
70
71sub pretty_sender {
72    my ($m) = @_;
73    return strip_realm($m->sender);
74}
75
76sub pretty_recipient {
77    my ($m) = @_;
78    return strip_realm($m->recipient);
79}
80
81# Portion of the reply command that preserves the context
82sub context_reply_cmd {
83    my $mclass = shift;
84    my $minstance = shift;
85    my $class = "";
86    if (lc($mclass) ne "message") {
87        $class = "-c " . BarnOwl::quote($mclass);
88    }
89    my $instance = "";
90    if (lc($minstance) ne "personal") {
91        $instance = "-i " . BarnOwl::quote($minstance);
92    }
93    if (($class eq "") or  ($instance eq "")) {
94        return $class . $instance;
95    } else {
96        return $class . " " . $instance;
97    }
98}
99
100sub personal_context {
101    my ($m) = @_;
102    return context_reply_cmd($m->class, $m->instance);
103}
104
105sub short_personal_context {
106    my ($m) = @_;
107    if(lc($m->class) eq 'message')
108    {
109        if(lc($m->instance) eq 'personal')
110        {
111            return '';
112        } else {
113            return $m->instance;
114        }
115    } else {
116        return $m->class;
117    }
118}
119
120# These are arguably zephyr-specific
121sub class       { return shift->{"class"}; }
122sub instance    { return shift->{"instance"}; }
123sub realm       { return shift->{"realm"}; }
124sub opcode      { return shift->{"opcode"}; }
125sub host        { return shift->{"hostname"}; }
126sub hostname    { return shift->{"hostname"}; }
127sub header      { return shift->{"header"}; }
128sub auth        { return shift->{"auth"}; }
129sub fields      { return shift->{"fields"}; }
130sub zsig        { return shift->{"zsig"}; }
131
132sub zephyr_cc {
133    my $self = shift;
134    return $1 if $self->body =~ /^\s*cc:\s+([^\n]+)/i;
135    return undef;
136}
137
138sub replycmd {
139    my $self = shift;
140    my $sender = shift;
141    $sender = 0 unless defined $sender;
142    my ($class, $instance, $to, $cc);
143    if($self->is_outgoing) {
144        return $self->{zwriteline};
145    }
146
147    if($sender && $self->opcode eq WEBZEPHYR_OPCODE) {
148        $class = WEBZEPHYR_CLASS;
149        $instance = $self->pretty_sender;
150        $instance =~ s/-webzephyr$//;
151        $to = WEBZEPHYR_PRINCIPAL;
152    } elsif($self->class eq WEBZEPHYR_CLASS
153            && $self->is_loginout) {
154        $class = WEBZEPHYR_CLASS;
155        $instance = $self->instance;
156        $to = WEBZEPHYR_PRINCIPAL;
157    } elsif($self->is_loginout) {
158        $class = 'MESSAGE';
159        $instance = 'PERSONAL';
160        $to = $self->sender;
161    } elsif($sender && !$self->is_private) {
162        # Possible future feature: (Optionally?) include the class and/or
163        # instance of the message being replied to in the instance of the
164        # outgoing personal reply
165        $class = 'MESSAGE';
166        $instance = 'PERSONAL';
167        $to = $self->sender;
168    } else {
169        $class = $self->class;
170        $instance = $self->instance;
171        $to = $self->recipient;
172        $cc = $self->zephyr_cc();
173        if($to eq '*' || $to eq '') {
174            $to = '';
175        } elsif($to !~ /^@/) {
176            $to = $self->sender;
177        }
178    }
179
180    my $cmd;
181    if(lc $self->opcode eq 'crypt' and ( not $sender or $self->is_private)) {
182        # Responses to zcrypted messages should be zcrypted, so long as we
183        # aren't switching to personals
184        $cmd = 'zcrypt';
185    } else {
186        $cmd = 'zwrite';
187    }
188
189    my $context_part = context_reply_cmd($class, $instance);
190    $cmd .= " " . $context_part unless ($context_part eq '');
191    if ($to ne '') {
192        $to = strip_realm($to);
193        if (defined $cc) {
194            my @cc = grep /^[^-]/, ($to, split /\s+/, $cc);
195            my %cc = map {$_ => 1} @cc;
196            delete $cc{strip_realm(BarnOwl::zephyr_getsender())};
197            @cc = keys %cc;
198            $cmd .= " -C " . join(" ", @cc);
199        } else {
200            if(BarnOwl::getvar('smartstrip') eq 'on') {
201                $to = BarnOwl::zephyr_smartstrip_user($to);
202            }
203            $cmd .= " $to";
204        }
205    }
206    return $cmd;
207}
208
209sub replysendercmd {
210    my $self = shift;
211    return $self->replycmd(1);
212}
213
214
2151;
Note: See TracBrowser for help on using the repository browser.