File Coverage

blib/lib/Net/RFC3161/Timestamp.pm
Criterion Covered Total %
statement 18 80 22.5
branch 0 24 0.0
condition 0 7 0.0
subroutine 6 12 50.0
pod 5 6 83.3
total 29 129 22.4


line stmt bran cond sub pod time code
1             package Net::RFC3161::Timestamp;
2             # ABSTRACT: Utility functions to request RFC3161 timestamps
3             $Net::RFC3161::Timestamp::VERSION = '0.010';
4 1     1   2724 use strict;
  1         3  
  1         38  
5 1     1   6 use warnings;
  1         2  
  1         36  
6 1     1   5 use Exporter 'import';
  1         2  
  1         30  
7 1     1   6 use Carp;
  1         2  
  1         70  
8 1     1   503 use HTTP::Request;
  1         19446  
  1         42  
9 1     1   873 use LWP::UserAgent;
  1         28929  
  1         865  
10              
11             our @EXPORT = qw(list_tsas attest_file);
12             our @EXPORT_OK = qw(dump_ts make_request_for_file post_request write_response_to_file);
13              
14              
15              
16             my %TSAs = (
17             ## RFC 3161 compatible:
18             "certum" => "http://time.certum.pl/",
19             "comodo" => "http://timestamp.comodoca.com/",
20             "digicert" => "http://timestamp.digicert.com/",
21             "globalsign" => "http://timestamp.globalsign.com/scripts/timestamp.dll",
22             "quovadis" => "http://tsa01.quovadisglobal.com/TSS/HttpTspServer",
23             "startcom" => "http://tsa.startssl.com/rfc3161",
24             "verisign" => "http://sha256timestamp.ws.symantec.com/sha256/timestamp",
25             # national
26             "dfn.de" => "http://zeitstempel.dfn.de",
27             "ermis.gov.gr" => "http://timestamp.ermis.gov.gr/TSS/HttpTspServer",
28             "e-guven.com" => "http://zd.e-guven.com/TSS/HttpTspServer",
29             "ssc.lt" => "http://gdlqtsa.ssc.lt/TSS/HttpTspServer",
30             );
31              
32             sub list_tsas() {
33 0     0 1   return \%TSAs;
34             }
35              
36              
37             sub dump_ts {
38 0     0 0   my ($kind, $buf) = @_;
39              
40 0 0         if (open(my $fh, "|-", "openssl", "ts", "-$kind",
41             "-in" => "/dev/stdin",
42             "-text"))
43             {
44 0           $fh->binmode;
45 0           $fh->write($buf);
46 0           $fh->close;
47             } else {
48 0           _warn("failed to spawn 'openssl ts'");
49             }
50             }
51              
52              
53             sub make_request_for_file {
54 0     0 1   my ($file, $hash_algo, $policy) = @_;
55 0   0       $hash_algo //= "sha512";
56              
57 0           my @cmd = ("openssl", "ts", "-query",
58             "-data" => $file,
59             "-$hash_algo",
60             "-cert");
61 0 0         if ($policy) {
62 0           push @cmd, ("-policy" => $policy);
63             }
64              
65 0 0         if (open(my $fh, "-|", @cmd)) {
66 0           my $req_buf;
67 0           $fh->binmode;
68 0           $fh->read($req_buf, 4*1024);
69 0           $fh->close;
70 0           return $req_buf;
71             } else {
72 0           croak("failed to spawn 'openssl ts'");
73             }
74             }
75              
76              
77             sub post_request {
78 0     0 1   my ($req_buf, $tsa_url) = @_;
79            
80 0 0         croak "no timestamping request given" unless defined $req_buf;
81 0   0       $tsa_url //= "dfn.de";
82              
83 0 0         if ($tsa_url !~ m!^https?://!) {
84 0 0         if ($TSAs{$tsa_url}) {
85 0           $tsa_url = $TSAs{$tsa_url};
86             } else {
87 0           croak("unknown timestamping authority '$tsa_url'");
88             }
89             }
90            
91 0           my $ua = LWP::UserAgent->new;
92              
93 0           my $req = HTTP::Request->new("POST", $tsa_url);
94 0           $req->protocol("HTTP/1.0");
95 0           $req->header("Content-Type" => "application/timestamp-query");
96 0           $req->header("Accept" => "application/timestamp-reply,application/timestamp-response");
97 0           $req->content($req_buf);
98              
99 0           my $res = $ua->request($req);
100 0 0         if ($res->code == 200) {
101 0           my $ct = $res->header("Content-Type");
102 0 0 0       if ($ct eq "application/timestamp-reply"
103             || $ct eq "application/timestamp-response")
104             {
105 0           return $res->content;
106             } else {
107 0           croak("server returned wrong content-type '$ct'");
108             }
109             } else {
110 0           croak("server returned error '".$res->status_line."'");
111             }
112             }
113              
114              
115             sub write_response_to_file {
116 0     0 1   my ($res_buf, $file) = @_;
117              
118 0 0         if (open(my $fh, ">", $file)) {
119 0           $fh->binmode;
120 0           $fh->write($res_buf);
121 0           $fh->close;
122             } else {
123 0           croak("could not open '$file': $!");
124             }
125             }
126              
127              
128             sub attest_file {
129 0     0 1   my $in_file = shift;
130 0           my $out_file = shift;
131 0           my $tsa = shift;
132 0           my $hash_algo = shift;
133 0           my $policy = shift;
134 0           my $verbose = shift;
135              
136 0           my $req_buf = make_request_for_file($in_file, $hash_algo, $policy);
137 0 0         if ($verbose) {
138 0           say("generated timestamp query follows:");
139 0           dump_ts("query", $req_buf);
140             }
141              
142 0           my $res_buf = post_request($req_buf, $tsa);
143 0 0         if ($verbose) {
144 0           say("received timestamp reply follows:");
145 0           dump_ts("reply", $res_buf);
146             }
147              
148 0           write_response_to_file($res_buf, $out_file);
149 0 0         if ($verbose) {
150 0           say("wrote signed timestamp to '$out_file'");
151             }
152             }
153              
154             1;
155              
156             __END__