apps/tsget.in

   1 #!{- $config{HASHBANGPERL} -}
   2 # Copyright 2002-2018 The OpenSSL Project Authors. All Rights Reserved.
   3 # Copyright (c) 2002 The OpenTSA Project. All rights reserved.
   4 #
   5 # Licensed under the OpenSSL license (the "License").  You may not use
   6 # this file except in compliance with the License.  You can obtain a copy
   7 # in the file LICENSE in the source distribution or at
   8 # https://www.openssl.org/source/license.html
   9
  10 use strict;
  11 use IO::Handle;
  12 use Getopt::Std;
  13 use File::Basename;
  14 use WWW::Curl::Easy;
  15
  16 use vars qw(%options);
  17
  18 # Callback for reading the body.
  19 sub read_body {
  20     my ($maxlength, $state) = @_;
  21     my $return_data = "";
  22     my $data_len = length ${$state->{data}};
  23     if ($state->{bytes} < $data_len) {
  24         $data_len = $data_len - $state->{bytes};
  25         $data_len = $maxlength if $data_len > $maxlength;
  26         $return_data = substr ${$state->{data}}, $state->{bytes}, $data_len;
  27         $state->{bytes} += $data_len;
  28     }
  29     return $return_data;
  30 }
  31
  32 # Callback for writing the body into a variable.
  33 sub write_body {
  34     my ($data, $pointer) = @_;
  35     ${$pointer} .= $data;
  36     return length($data);
  37 }
  38
  39 # Initialise a new Curl object.
  40 sub create_curl {
  41     my $url = shift;
  42
  43     # Create Curl object.
  44     my $curl = WWW::Curl::Easy::new();
  45
  46     # Error-handling related options.
  47     $curl->setopt(CURLOPT_VERBOSE, 1) if $options{d};
  48     $curl->setopt(CURLOPT_FAILONERROR, 1);
  49     $curl->setopt(CURLOPT_USERAGENT,
  50         "OpenTSA tsget.pl/openssl-{- $config{version} -}");
  51
  52     # Options for POST method.
  53     $curl->setopt(CURLOPT_UPLOAD, 1);
  54     $curl->setopt(CURLOPT_CUSTOMREQUEST, "POST");
  55     $curl->setopt(CURLOPT_HTTPHEADER,
  56                 ["Content-Type: application/timestamp-query",
  57                 "Accept: application/timestamp-reply,application/timestamp-response"]);
  58     $curl->setopt(CURLOPT_READFUNCTION, \&read_body);
  59     $curl->setopt(CURLOPT_HEADERFUNCTION, sub { return length($_[0]); });
  60
  61     # Options for getting the result.
  62     $curl->setopt(CURLOPT_WRITEFUNCTION, \&write_body);
  63
  64     # SSL related options.
  65     $curl->setopt(CURLOPT_SSLKEYTYPE, "PEM");
  66     $curl->setopt(CURLOPT_SSL_VERIFYPEER, 1);   # Verify server's certificate.
  67     $curl->setopt(CURLOPT_SSL_VERIFYHOST, 2);   # Check server's CN.
  68     $curl->setopt(CURLOPT_SSLKEY, $options{k}) if defined($options{k});
  69     $curl->setopt(CURLOPT_SSLKEYPASSWD, $options{p}) if defined($options{p});
  70     $curl->setopt(CURLOPT_SSLCERT, $options{c}) if defined($options{c});
  71     $curl->setopt(CURLOPT_CAINFO, $options{C}) if defined($options{C});
  72     $curl->setopt(CURLOPT_CAPATH, $options{P}) if defined($options{P});
  73     $curl->setopt(CURLOPT_RANDOM_FILE, $options{r}) if defined($options{r});
  74     $curl->setopt(CURLOPT_EGDSOCKET, $options{g}) if defined($options{g});
  75
  76     # Setting destination.
  77     $curl->setopt(CURLOPT_URL, $url);
  78
  79     return $curl;
  80 }
  81
  82 # Send a request and returns the body back.
  83 sub get_timestamp {
  84     my $curl = shift;
  85     my $body = shift;
  86     my $ts_body;
  87     local $::error_buf;
  88
  89     # Error-handling related options.
  90     $curl->setopt(CURLOPT_ERRORBUFFER, "::error_buf");
  91
  92     # Options for POST method.
  93     $curl->setopt(CURLOPT_INFILE, {data => $body, bytes => 0});
  94     $curl->setopt(CURLOPT_INFILESIZE, length(${$body}));
  95
  96     # Options for getting the result.
  97     $curl->setopt(CURLOPT_FILE, \$ts_body);
  98
  99     # Send the request...
 100     my $error_code = $curl->perform();
 101     my $error_string;
 102     if ($error_code != 0) {
 103         my $http_code = $curl->getinfo(CURLINFO_HTTP_CODE);
 104         $error_string = "could not get timestamp";
 105         $error_string .= ", http code: $http_code" unless $http_code == 0;
 106         $error_string .= ", curl code: $error_code";
 107         $error_string .= " ($::error_buf)" if defined($::error_buf);
 108     } else {
 109         my $ct = $curl->getinfo(CURLINFO_CONTENT_TYPE);
 110         if (lc($ct) ne "application/timestamp-reply"
 111             && lc($ct) ne "application/timestamp-response") {
 112             $error_string = "unexpected content type returned: $ct";
 113         }
 114     }
 115     return ($ts_body, $error_string);
 116
 117 }
 118
 119 # Print usage information and exists.
 120 sub usage {
 121
 122     print STDERR "usage: $0 -h <server_url> [-e <extension>] [-o <output>] ";
 123     print STDERR "[-v] [-d] [-k <private_key.pem>] [-p <key_password>] ";
 124     print STDERR "[-c <client_cert.pem>] [-C <CA_certs.pem>] [-P <CA_path>] ";
 125     print STDERR "[-r <file:file...>] [-g <EGD_socket>] [<request>]...\n";
 126     exit 1;
 127 }
 128
 129 # ----------------------------------------------------------------------
 130 #   Main program
 131 # ----------------------------------------------------------------------
 132
 133 # Getting command-line options (default comes from TSGET environment variable).
 134 my $getopt_arg =  "h:e:o:vdk:p:c:C:P:r:g:";
 135 if (exists $ENV{TSGET}) {
 136     my @old_argv = @ARGV;
 137     @ARGV = split /\s+/, $ENV{TSGET};
 138     getopts($getopt_arg, \%options) or usage;
 139     @ARGV = @old_argv;
 140 }
 141 getopts($getopt_arg, \%options) or usage;
 142
 143 # Checking argument consistency.
 144 if (!exists($options{h}) || (@ARGV == 0 && !exists($options{o}))
 145     || (@ARGV > 1 && exists($options{o}))) {
 146     print STDERR "Inconsistent command line options.\n";
 147     usage;
 148 }
 149 # Setting defaults.
 150 @ARGV = ("-") unless @ARGV != 0;
 151 $options{e} = ".tsr" unless defined($options{e});
 152
 153 # Processing requests.
 154 my $curl = create_curl $options{h};
 155 undef $/;   # For reading whole files.
 156 REQUEST: foreach (@ARGV) {
 157     my $input = $_;
 158     my ($base, $path) = fileparse($input, '\.[^.]*');
 159     my $output_base = $base . $options{e};
 160     my $output = defined($options{o}) ? $options{o} : $path . $output_base;
 161
 162     STDERR->printflush("$input: ") if $options{v};
 163     # Read request.
 164     my $body;
 165     if ($input eq "-") {
 166         # Read the request from STDIN;
 167         $body = <STDIN>;
 168     } else {
 169         # Read the request from file.
 170         open INPUT, "<" . $input
 171             or warn("$input: could not open input file: $!\n"), next REQUEST;
 172         $body = <INPUT>;
 173         close INPUT
 174             or warn("$input: could not close input file: $!\n"), next REQUEST;
 175     }
 176
 177     # Send request.
 178     STDERR->printflush("sending request") if $options{v};
 179
 180     my ($ts_body, $error) = get_timestamp $curl, \$body;
 181     if (defined($error)) {
 182         die "$input: fatal error: $error\n";
 183     }
 184     STDERR->printflush(", reply received") if $options{v};
 185
 186     # Write response.
 187     if ($output eq "-") {
 188         # Write to STDOUT.
 189         print $ts_body;
 190     } else {
 191         # Write to file.
 192         open OUTPUT, ">", $output
 193             or warn("$output: could not open output file: $!\n"), next REQUEST;
 194         print OUTPUT $ts_body;
 195         close OUTPUT
 196             or warn("$output: could not close output file: $!\n"), next REQUEST;
 197     }
 198     STDERR->printflush(", $output written.\n") if $options{v};
 199 }
 200 $curl->cleanup();