summaryrefslogtreecommitdiffstats
path: root/config/chroot_local-includes/usr/local/sbin/htpdate
blob: 2f66109b2e5ed8c25863510977de17166302ac65 (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
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
#!/usr/bin/perl
#
# htpdate time poller version 0.9.3
# Copyright (C) 2005 Eddy Vervest
# Copyright (C) 2010-2011 Tails developers <tails@boum.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# http://www.gnu.org/copyleft/gpl.html

use strict;
use warnings;

use version; our $VERSION = qv('0.9.3');

use Carp;
use Cwd;
use Data::Dumper;
use DateTime;
use DateTime::Format::DateParse;
use English qw( -no_match_vars );
use File::Path qw(rmtree);
use File::Spec::Functions;
use File::Temp qw/tempdir/;
use Getopt::Long::Descriptive;
use IPC::System::Simple qw(capturex);
use List::Util qw( shuffle );
use open qw{:utf8 :std};
use threads;
use Try::Tiny;

my $datecommand = '/bin/date';  # "date" command to set time
my $dateparam   = '-s';         # "date" parameter to set time
my $maxadjust   = 0;            # maximum time step in seconds (0 means no max.)
my $minadjust   = 1;            # minimum time step in seconds
my (
    $debug, $useragent, $log, $quiet, $set_date,
    $done_file, $res_file, $usage, $opt, $runas,
    $allowed_per_pool_failure_ratio, $proxy, @pools,
    $max_try_per_url, $new_tor_circuit_on_retry,
);

sub done {
    if (defined $done_file) {
	$> = 0 if $runas;
	open my $f, '>', $done_file or
	    print STDERR "Couldn't write done file: $done_file\n";
	close $f;
	$> = getpwnam($runas) if $runas;
    }
}

$SIG{__DIE__} = sub {
    # Avoid the "done" file to be created by an catched exception.
    # When a eval block is being run, e.g. for exception catching, $^S is true.
    # It is false otherwise.
    done unless $^S;
    die(@_);
};

sub message {
    my @msg = @_;

    if ($log) {
        open my $h, '>>', $log or die "Cannot open log file $log: $!";
        print $h "@msg\n";
        close $h;
    }
    else {
        print "@msg\n" unless $quiet;
    }
}

sub debug {
    message(@_) if $debug;
}

sub error {
    debug(@_);
    croak @_;
}

sub parseCommandLine () {
    # specify valid switches
    ($opt, $usage) = describe_options(
        'htpdate %o',
        [ 'debug|d', "debug", { default => 0 } ],
        [ 'help', "print usage message and exit" ],
        [ 'quiet|q', "quiet", { default => 0 } ],
        [ 'user|u:s', "userid to run as" ],
        [ 'dont_set_date|x', "do not set the time (only show)", { default => 0 } ],
        [ 'user_agent|a:s', "http user agent to use", { default => "htpdate/$VERSION" } ],
        [ 'log_file|l:s', "log to this file rather than to STDOUT" ],
        [ 'done_file|D:s', "create this file after quitting in any way" ],
        [ 'success_file|T:s', "create this file after setting time successfully" ],
        [ 'pal_pool=s@', "distrusted hostnames" ],
        [ 'neutral_pool=s@', "neutral hostnames" ],
        [ 'foe_pool=s@', "distrusted hostnames" ],
        [ 'allowed_per_pool_failure_ratio:f', "ratio (0.0-1.0) of allowed per-pool failure", { default => 1.0 } ],
        [ 'max_try_per_url', "Number of times to try to fetch each url", { default => 1 } ],
        [ 'new_tor_circuit_on_retry', "Use a new Tor circuit each time a url is retried", { default => 0 } ],
        [ 'proxy|p:s', "what to pass to curl's --socks5-hostname (if unset, environment variables may affect curl's behavior -- see curl(1) for details)" ],
    );

    usage() if $opt->help;
    usage() unless $opt->pal_pool && $opt->neutral_pool && $opt->foe_pool;

    $runas       = $opt->user if $opt->user;
    $>           = getpwnam($runas) if $runas;
    $useragent   = $opt->user_agent;
    $debug       = $opt->debug;
    $log         = $opt->log_file if $opt->log_file;
    $quiet       = $opt->quiet;
    $set_date    = ! $opt->dont_set_date;
    $done_file   = $opt->done_file if $opt->done_file;
    $res_file    = $opt->success_file if $opt->success_file;
    $allowed_per_pool_failure_ratio = $opt->allowed_per_pool_failure_ratio;
    $max_try_per_url = $opt->max_try_per_url;
    $new_tor_circuit_on_retry = $opt->new_tor_circuit_on_retry;
    $proxy       = $opt->proxy if $opt->proxy;
    @pools = map {
        [
            map {
                $_ = 'https://'.$_ unless $_ =~ /^http/i;
            } split(/,/, join(',', @{$_}))
        ]
    } ($opt->pal_pool, $opt->neutral_pool, $opt->foe_pool);
}

sub usage () {
    print STDERR $usage->text;
    exit;
}

sub newestDateHeader {
    my ($dir) = @_;

    my @files = grep { ! ( $_ =~ m|/?\.{1,2}$| ) } glob("$dir/.* $dir/*");
    @files or error "No downloaded files can be found";

    my $newestdt;

    foreach my $file (@files) {
        next if -l $file || -d _;
        my $date;
        open(my $file_h, '<', $file) or die "Can not read file $file: $!";
        while (my $line = <$file_h>) {
            chomp $line;
            # empty line == we leave the headers to go into the content
            last if $line eq '';
            last if ($date) = ($line =~ m/^\s*[Dd]ate:\s+(.*)$/m);
        }
        close $file_h;
        if (defined $date) {
            # RFC 2616 (3.3.1) says Date headers MUST be represented in GMT
            my $dt = DateTime::Format::DateParse->parse_datetime( $date, 'GMT' );
            if (! defined $newestdt || DateTime->compare($dt, $newestdt) > 0) {
                $newestdt = $dt;
            }
        }
    }

    return $newestdt;
}

=head2 random_first_with_allowed_failure_ratio

Returns the result of the first successful application of
$args->{code} on a random element of $args->{list}.
Success is tested using the $args->{is_success} predicate,
called on the value returned by $args->{code}.

$args->{allowed_failure_ratio} caps the maximum failure ratio before
giving up.

$args->{code} is called with two arguments: the currently (randomly
picked) considered element, and $args->{args}.

Any exceptions thrown by $args->{code} is catched.

=cut
sub random_first_with_allowed_failure_ratio {
    my $args = shift;

    my %tried;
    $tried{$_} = 0 for (@{$args->{list}});
    my $failures = 0;
    my $total = keys %tried;

    while ( $failures / $total <= $args->{allowed_failure_ratio} ) {
        my @randomized_left = shuffle grep { ! $tried{$_} } keys(%tried);
        my $picked = $randomized_left[0];
        $tried{$picked}++;
        my $res;
        try {
            $res = $args->{code}->($picked, $args->{args})
        };
        return $res if $args->{is_success}->($res);
        $failures++;
    }

    return;
}

sub requestNewTorCircuit {
    my @newnym_command = ('.', '/usr/local/lib/tails-shell-library/tor.sh',
                          '&&', 'tor_control_send', '\'NEWNYM\'',
                          '>/dev/null', '2>&1');

    debug("Requesting new Tor circuit");
    system('sh', '-c', @newnym_command);
}

sub dateWhenRetryGetUrl {
    my $url = shift;
    my @curl_options = @_;

    my $tried = 1;
    my @curl_command = ('curl', @curl_options, $url);

    while ( $tried <= $max_try_per_url ) {
        $tried++;
        my $before = DateTime->now->epoch();
        my $cmd = try {
            system(@curl_command);
            die if $? != 0;
        } catch {
            if ( $tried <= $max_try_per_url ) {
                debug("Fetching $url failed, trying again");
                if ( $new_tor_circuit_on_retry ) {
                    requestNewTorCircuit();
                }
                $before = DateTime->now->epoch();
	    }
        };
        return $before if $cmd == 0;
    }
    error "Failed to fetch content from $url";
}

sub getPoolDateDiff {
    my $args = shift;

    random_first_with_allowed_failure_ratio({
        list => $args->{urls},
        code => \&getUrlDateDiff,
        is_success => sub { defined shift },
        allowed_failure_ratio => $allowed_per_pool_failure_ratio,
    });
}

sub getUrlDateDiff {
    my $url = shift;
    my $args = shift;

    defined $url or error "getUrlDateDiff must be passed an URL";
    debug("getUrlDateDiff: $url");

    my $tmpdir = tempdir("XXXXXXXXXX", TMPDIR => 1);

    my @curl_options = (
        '--user-agent', $useragent, '--silent',
        '--proto', '=https', '--tlsv1',
        '--max-time', '30',
        '--head', '--output', catfile($tmpdir, 'headers'),
    );
    push @curl_options, ('--socks5-hostname', $proxy) if defined $proxy;

    # fetch (the page and) referenced resources:
    # images, stylesheets, scripts, etc.
    my $local = DateTime->now->epoch();
    my $before = dateWhenRetryGetUrl($url, @curl_options);
    my $newestdt;
    eval { $newestdt = newestDateHeader($tmpdir) };
    if ($EVAL_ERROR =~ m/No downloaded files can be found/) {
        rmtree($tmpdir);
        error "No file could be downloaded from $url.";
    }

    rmtree($tmpdir);

    defined $newestdt or error "Could not get any Date header from $url";
    my $newest_epoch = $newestdt->epoch();

    my $diff = $newest_epoch - $local;
    my $took = $local - $before;

    debug("$url (took ${took}s) => diff = $diff second(s)");

    return $diff;
}

sub adjustDate {
    my ($diff) = @_;

    defined $diff or error "adjustDate was passed an undefined diff";

    my $local = DateTime->now->epoch();
    my $absdiff = abs($diff);

    debug("Median diff: $diff second(s)");

    if ( $maxadjust && $absdiff gt $maxadjust ) {
        message("Not setting clock as diff ($diff seconds) is too large.");
    }
    elsif ( $absdiff lt $minadjust) {
        message("Not setting clock as diff ($diff seconds) is too small.");
    }
    else {
        my $newtime = DateTime->now->epoch + $diff;
        message("Setting time to $newtime...");
        if ($set_date) {
            $> = 0 if $runas;
            my $output;
            try {
                $output = capturex($datecommand, $dateparam, '@' . $newtime);
            } catch {
                error "An error occured setting the time\n$output";
            };
            $> = getpwnam($runas) if $runas;
        }
    }
    if (defined $res_file) {
        $> = 0 if $runas;
        open my $res_h, '>>', $res_file or die "Cannot open res file $res_file: $!";
        print $res_h "$diff\n";
        close $res_h;
        $> = getpwnam($runas) if $runas;
    }
}

sub median {
    my @a = sort {$a <=> $b} @_;
    return ($a[$#a/2] + $a[@a/2]) / 2;
}

parseCommandLine();
message("Running htpdate.");
my @diffs = grep {
    defined $_
} map {
    my $diff = $_->join();
    if (! defined $diff) {
        error('Aborting as one pool could not be reached');
    }
    $diff;
} map {
    threads->create(\&getPoolDateDiff, { urls => $_ })
} @pools
    or error "No Date header could be received.";
adjustDate(median(@diffs));
done;