summaryrefslogtreecommitdiffstats
path: root/config/chroot_local-includes/usr/local/bin/tails-security-check
blob: 6611623b045094bfe5c496e94be35dc4d5196d3a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
#! /usr/bin/perl

use strict;
use warnings FATAL => 'all';
use 5.10.1;

#man{{{

=head1 NAME

tails-security-check

=cut


=head1 DESCRIPTION

=head1 SYNOPSIS

tails-security-check [ ATOM_FEED_BASE_URL ]

  ATOM_FEED_BASE_URL will be appended /index.XX.atom,
  for XX in (current locale's language code, 'en'),
  until success is reported by the HTTP layer.

=head1 AUTHOR

Tails developers <tails@boum.org>
See https://tails.boum.org/.

=cut

#}}}

use Carp;
use Carp::Assert::More;
use Desktop::Notify;
use Fatal qw{open close};
use Locale::gettext;
use POSIX;
use XML::Atom;
use XML::Atom::Feed;

### Initialization

use IO::Socket::SSL;
use Net::SSLeay;
BEGIN {
    IO::Socket::SSL::set_ctx_defaults(
        verify_mode => Net::SSLeay->VERIFY_PEER(),
        ca_file => '/etc/ssl/certs/UTN_USERFirst_Hardware_Root_CA.pem',
    );
}
use LWP::UserAgent; # needs to be *after* IO::Socket::SSL's initialization

setlocale(LC_MESSAGES, "");
textdomain("tails");

### configuration

my $version_file     = '/etc/amnesia/version';
my $default_base_url = 'https://tails.boum.org/security/';

=head1 FUNCTIONS

=head2 current_lang

Returns the two-letters language code of the current session.

=cut
sub current_lang {
    my ($code) = ($ENV{LANG} =~ m/([a-z]{2}).*/);

    return $code;
}

=head2 atom_str

Argument: an Atom feed URL

Returns the Atom's feed content on success, undef on failure.

=cut
sub atom_str {
    my $url = shift;
    assert_defined($url);

    $ENV{HTTPS_VERSION} = 3;

    my $ua  = LWP::UserAgent->new;
    $ua->proxy([qw(http https)] => 'socks://127.0.0.1:9062')
        unless $ENV{DISABLE_PROXY};
    my $req = HTTP::Request->new('GET', $url);
    my $res = $ua->request($req);
    if (defined $res && $res->is_success) {
        return $res->content;
    }

    return undef;
}

=head2 get_entries

Arguments: the Atom feed URL.

Returns the list of XML::Atom::Entry objects from the feed.

We use this manual Accept-Language algorithm as the website
layout does not allow us to use content negotiation.

=cut
sub get_entries {
    my $base_url = shift;
    assert_defined($base_url);
    assert_nonblank($base_url);

    my $separator = '';
    $separator = '/' unless $base_url =~ m{/\z}xms;

    my @try_urls = (
        $base_url . $separator . 'index.' . current_lang() . '.atom',
        $base_url . $separator . 'index.en.atom',
    );

    my $feed_str;
    foreach my $url (@try_urls) {
        last if ($feed_str = atom_str($url));
    }
    assert_defined($feed_str);

    return XML::Atom::Feed->new(\$feed_str)->entries();
}

=head2 notify_user

Use the Desktop Notifications framework to notify the user about the
Atom entries passed as arguments.

=cut
sub notify_user {
    my @entries = @_;

    my $notify = Desktop::Notify->new();

    my $summary = gettext('This version of Tails has known security issues:');
    my $body = '';

    for (@entries) {
        $body .= '- ' . '<a href="' . $_->id . '">' . $_->title . '</a>' . "\n";
    }

    say $body;

    $notify->create(summary => $summary,
                    body => $body,
                    timeout => 0)->show();
}

=head2 categories

Return the list of categories of the input XML::Atom::Entry object.

=cut
sub categories {
    my $entry = shift;
    my $ns = XML::Atom::Namespace->new(
        dc => 'http://purl.org/dc/elements/1.1/'
    );
    my @category = ($entry->can('categories'))
        ? $entry->categories
        : $entry->category;
    @category
        ? (map { $_->label || $_->term } @category)
        : $entry->getlist($ns, 'subject');
}

=head2 is_not_fixed

Returns true iff. the input XML::Atom::Entry object hasn't the
security/fixed tag.

=cut
sub is_not_fixed {
    my $entry = shift;
    assert_isa($entry, 'XML::Atom::Entry');

    ! grep { $_ eq 'security/fixed' } categories($entry);
}

=head2 unfixed_entries

Filter the input list of XML::Atom::Entry objects to only keep entries
that are not marked as fixed yet.

=cut
sub unfixed_entries {
    my @entries = @_;

    grep { is_not_fixed($_) } @entries;
}

=head1 MAIN

=head2 sanity checks

=cut
if (! -e "$version_file") {
    die "The Tails version file ($version_file) does not exist."
}
if (! -r "$version_file") {
    die "The Tails version file ($version_file) is not readable."
}

=head2 parse command line args

=cut
my $base_url  = shift || $default_base_url;
my $opt_since = shift;


=head2 do the work

=cut
my @unfixed_entries = unfixed_entries(get_entries($base_url));

if (! @unfixed_entries) {
    exit 0;
}
else {
    notify_user(@unfixed_entries);
}