tsget revision 325337 
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
6use strict;
7use IO::Handle;
8use Getopt::Std;
9use File::Basename;
10use WWW::Curl::Easy;
11
12use vars qw(%options);
13
14# Callback for reading the body.
15sub 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.
29sub write_body {
30    my ($data, $pointer) = @_;
31    ${$pointer} .= $data;
32    return length($data);
33}
34
35# Initialise a new Curl object.
36sub 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 / /, $::version)[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-response"]);
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.
78sub 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.
115sub 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).
129my $getopt_arg =  "h:e:o:vdk:p:c:C:P:r:g:";
130if (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}
136getopts($getopt_arg, \%options) or usage;
137
138# Checking argument consistency.
139if (!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.
149my $curl = create_curl $options{h};
150undef $/;   # For reading whole files.
151REQUEST: 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