yuezonghe | 824eb0c | 2024-06-27 02:32:26 -0700 | [diff] [blame] | 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(); |