htpdate 9.24 KB
Newer Older
amnesia's avatar
amnesia committed
1 2 3 4
#!/usr/bin/perl
#
# htpdate time poller version 0.9.3
# Copyright (C) 2005 Eddy Vervest
5
# Copyright (C) 2010-2011 Tails developers <tails@boum.org>
amnesia's avatar
amnesia committed
6 7 8 9 10 11 12 13 14 15 16 17 18 19
#
# 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;
20
use Data::Dumper;
amnesia's avatar
amnesia committed
21 22
use DateTime;
use DateTime::Format::DateParse;
amnesia's avatar
amnesia committed
23
use English qw( -no_match_vars );
amnesia's avatar
amnesia committed
24
use File::Path qw(rmtree);
25
use File::Spec::Functions;
amnesia's avatar
amnesia committed
26
use File::Temp qw/tempdir/;
27 28
use Getopt::Long::Descriptive;
use List::Util qw( shuffle );
amnesia's avatar
amnesia committed
29 30
use open qw{:utf8 :std};
use POSIX qw( WIFEXITED );
amnesia's avatar
amnesia committed
31
use threads;
32
use Try::Tiny;
amnesia's avatar
amnesia committed
33 34 35

my $datecommand = '/bin/date';  # "date" command to set time
my $dateparam   = '-s';         # "date" parameter to set time
36
my $maxadjust   = 0;            # maximum time step in seconds (0 means no max.)
amnesia's avatar
amnesia committed
37
my $minadjust   = 1;            # minimum time step in seconds
38
my (
39 40 41
    $debug, $useragent, $log, $quiet, $set_date,
    $done_file, $res_file, $usage, $opt, $runas,
    $allowed_per_pool_failure_ratio, $proxy, @pools,
42
);
43 44 45

sub done {
    if (defined $done_file) {
46
	$> = 0 if $runas;
47 48 49
	open my $f, '>', $done_file or
	    print STDERR "Couldn't write done file: $done_file\n";
	close $f;
50
	$> = getpwnam($runas) if $runas;
51 52 53 54
    }
}

$SIG{__DIE__} = sub {
55 56 57 58
    # 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;
59 60
    die(@_);
};
amnesia's avatar
amnesia committed
61 62 63 64 65

sub message {
    my @msg = @_;

    if ($log) {
amnesia's avatar
amnesia committed
66
        open my $h, '>>', $log or die "Cannot open log file $log: $!";
amnesia's avatar
amnesia committed
67 68 69 70 71 72 73 74 75 76 77 78
        print $h "@msg\n";
        close $h;
    }
    else {
        print "@msg\n" unless $quiet;
    }
}

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

79 80 81
sub error {
    debug(@_);
    croak @_;
amnesia's avatar
amnesia committed
82
}
amnesia's avatar
amnesia committed
83 84 85

sub parseCommandLine () {
    # specify valid switches
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
    ($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 } ],
Tails developers's avatar
Tails developers committed
101
        [ '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)" ],
102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
    );

    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;
117
    $proxy       = $opt->proxy if $opt->proxy;
118 119 120 121 122 123 124
    @pools = map {
        [
            map {
                $_ = 'https://'.$_ unless $_ =~ /^http/i;
            } split(/,/, join(',', @{$_}))
        ]
    } ($opt->pal_pool, $opt->neutral_pool, $opt->foe_pool);
amnesia's avatar
amnesia committed
125 126 127
}

sub usage () {
128
    print STDERR $usage->text;
amnesia's avatar
amnesia committed
129 130 131 132 133 134
    exit;
}

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

135
    my @files = grep { ! ( $_ =~ m|/?\.{1,2}$| ) } glob("$dir/.* $dir/*");
amnesia's avatar
amnesia committed
136
    @files or error "No downloaded files can be found";
amnesia's avatar
amnesia committed
137 138 139 140 141 142

    my $newestdt;

    foreach my $file (@files) {
        next if -l $file || -d _;
        my $date;
amnesia's avatar
amnesia committed
143
        open(my $file_h, '<', $file) or die "Can not read file $file: $!";
amnesia's avatar
amnesia committed
144 145 146 147
        while (my $line = <$file_h>) {
            chomp $line;
            # empty line == we leave the headers to go into the content
            last if $line eq '';
148
            last if ($date) = ($line =~ m/^\s*Date:\s+(.*)$/m);
amnesia's avatar
amnesia committed
149 150 151 152 153 154 155 156 157 158 159 160 161 162
        }
        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;
}

163 164 165 166
=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}.
167 168
Success is tested using the $args->{is_success} predicate,
called on the value returned by $args->{code}.
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

$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})
        };
195
        return $res if $args->{is_success}->($res);
196 197 198 199 200 201 202 203 204 205 206 207
        $failures++;
    }

    return;
}

sub getPoolDateDiff {
    my $args = shift;

    random_first_with_allowed_failure_ratio({
        list => $args->{urls},
        code => \&getUrlDateDiff,
208
        is_success => sub { defined shift },
209 210 211 212 213 214 215
        allowed_failure_ratio => $allowed_per_pool_failure_ratio,
    });
}

sub getUrlDateDiff {
    my $url = shift;
    my $args = shift;
amnesia's avatar
amnesia committed
216

217 218
    defined $url or error "getUrlDateDiff must be passed an URL";
    debug("getUrlDateDiff: $url");
amnesia's avatar
amnesia committed
219

220
    my $tmpdir = tempdir("XXXXXXXXXX", TMPDIR => 1);
amnesia's avatar
amnesia committed
221

222 223 224 225
    my @curl_options = (
        '--user-agent', $useragent, '--silent',
        '--proto', '=https', '--tlsv1',
        '--head', '--output', catfile($tmpdir, 'headers'),
226
    );
227
    push @curl_options, ('--socks5-hostname', $proxy) if defined $proxy;
amnesia's avatar
amnesia committed
228

229
    my @cmdline = ('curl', @curl_options, $url);
amnesia's avatar
amnesia committed
230 231 232

    # fetch (the page and) referenced resources:
    # images, stylesheets, scripts, etc.
233
    my $before = DateTime->now->epoch();
amnesia's avatar
amnesia committed
234
    WIFEXITED(system(@cmdline)) or error "Failed to fetch content from $url: $!";
235
    my $local = DateTime->now->epoch();
amnesia's avatar
amnesia committed
236 237 238
    my $newestdt;
    eval { $newestdt = newestDateHeader($tmpdir) };
    if ($EVAL_ERROR =~ m/No downloaded files can be found/) {
amnesia's avatar
amnesia committed
239
        rmtree($tmpdir);
amnesia's avatar
amnesia committed
240
        error "No file could be downloaded from $url.";
amnesia's avatar
amnesia committed
241
    }
amnesia's avatar
amnesia committed
242

amnesia's avatar
amnesia committed
243 244
    rmtree($tmpdir);

amnesia's avatar
amnesia committed
245
    defined $newestdt or error "Could not get any Date header";
246
    my $newest_epoch = $newestdt->epoch();
amnesia's avatar
amnesia committed
247

248 249
    my $diff = $newest_epoch - $local;
    my $took = $local - $before;
250

amnesia's avatar
amnesia committed
251
    debug("$url (took ${took}s) => diff = $diff second(s)");
amnesia's avatar
amnesia committed
252

253
    return $diff;
amnesia's avatar
amnesia committed
254 255 256
}

sub adjustDate {
257
    my ($diff) = @_;
amnesia's avatar
amnesia committed
258

259
    defined $diff or error "adjustDate was passed an undefined diff";
amnesia's avatar
amnesia committed
260

261 262
    my $local = DateTime->now->epoch();
    my $absdiff = abs($diff);
amnesia's avatar
amnesia committed
263

amnesia's avatar
amnesia committed
264
    debug("Median diff: $diff second(s)");
amnesia's avatar
amnesia committed
265

266
    if ( $maxadjust && $absdiff gt $maxadjust ) {
amnesia's avatar
amnesia committed
267
        message("Not setting clock as diff ($diff seconds) is too large.");
amnesia's avatar
amnesia committed
268
    }
269
    elsif ( $absdiff lt $minadjust) {
amnesia's avatar
amnesia committed
270
        message("Not setting clock as diff ($diff seconds) is too small.");
amnesia's avatar
amnesia committed
271 272
    }
    else {
amnesia's avatar
amnesia committed
273
        my $newtime = DateTime->now->epoch + $diff;
amnesia's avatar
amnesia committed
274
        message("Setting time to $newtime...");
amnesia's avatar
amnesia committed
275
        if ($set_date) {
276
            $> = 0 if $runas;
amnesia's avatar
amnesia committed
277 278
            open(my $fd, "-|", $datecommand, $dateparam, '@' . $newtime)
                or die "Cannot set run command $datecommand: $!";
amnesia's avatar
amnesia committed
279
            if ( $? != 0 ) {
amnesia's avatar
amnesia committed
280 281
                my @output = <$fd>;
                error "An error occured setting the time\n@output";
amnesia's avatar
amnesia committed
282 283
            }
            close($fd);
284
            $> = getpwnam($runas) if $runas;
amnesia's avatar
amnesia committed
285 286
        }
    }
287 288 289 290 291 292 293
    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;
    }
amnesia's avatar
amnesia committed
294 295
}

Tails developers's avatar
Tails developers committed
296 297 298 299 300
sub median {
    my @a = sort {$a <=> $b} @_;
    return ($a[$#a/2] + $a[@a/2]) / 2;
}

301
parseCommandLine();
302
message("Running htpdate.");
303
my @diffs = grep {
304 305
    defined $_
} map {
306
    my $diff = $_->join();
307 308
    if (! defined $diff) {
        error('Aborting as one pool could not be reached');
309
    }
310
    $diff;
311
} map {
312
    threads->create(\&getPoolDateDiff, { urls => $_ })
313
} @pools
amnesia's avatar
amnesia committed
314
    or error "No Date header could be received.";
Tails developers's avatar
Tails developers committed
315
adjustDate(median(@diffs));
316
done;