1#!{- $config{HASHBANGPERL} -} 2# Copyright 2002-2021 The OpenSSL Project Authors. All Rights Reserved. 3# Copyright (c) 2002 The OpenTSA Project. All rights reserved. 4# 5# Licensed under the Apache License 2.0 (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 10use strict; 11use IO::Handle; 12use Getopt::Std; 13use File::Basename; 14use WWW::Curl::Easy; 15 16use vars qw(%options); 17 18# Callback for reading the body. 19sub 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. 33sub write_body { 34 my ($data, $pointer) = @_; 35 ${$pointer} .= $data; 36 return length($data); 37} 38 39# Initialise a new Curl object. 40sub 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{full_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. 83sub 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. 120sub 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). 134my $getopt_arg = "h:e:o:vdk:p:c:C:P:r:g:"; 135if (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} 141getopts($getopt_arg, \%options) or usage; 142 143# Checking argument consistency. 144if (!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. 154my $curl = create_curl $options{h}; 155undef $/; # For reading whole files. 156REQUEST: 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(); 201