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