| lh | 9ed821d | 2023-04-07 01:36:19 -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(); |