xref: /freebsd/crypto/openssl/apps/tsget.in (revision d34048812292b714a0bf99967270d18fe3097c62) 
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
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{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