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