html/volunteers: clean up some old style `/w` links
[girocco.git] / Girocco / TimedToken.pm
blobcb65d3133f5129e6385ea4317456182c67158aa5
1 # Girocco::TimedToken.pm -- HMAC Timed Token Utility Functions
2 # Copyright (C) 2021 Kyle J. McKay. All rights reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU General Public License
6 # as published by the Free Software Foundation; either version 2
7 # of the License, or (at your option) any later version.
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with this program; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 package Girocco::TimedToken;
20 use strict;
21 use warnings;
23 use Scalar::Util qw(refaddr looks_like_number);
24 use MIME::Base64;
25 use Digest::MD5 qw(md5);
26 BEGIN {
27 eval {
28 require Digest::SHA;
29 Digest::SHA->import(
30 qw(sha1)
31 );1} ||
32 eval {
33 require Digest::SHA1;
34 Digest::SHA1->import(
35 qw(sha1)
36 );1} ||
37 eval {
38 require Digest::SHA::PurePerl;
39 Digest::SHA::PurePerl->import(
40 qw(sha1)
41 );1} ||
42 die "One of Digest::SHA or Digest::SHA1 or Digest::SHA::PurePerl "
43 . "must be available\n";
45 use Girocco::HashUtil qw(hmac_sha1);
47 use base qw(Exporter);
48 our @EXPORT;
49 our $VERSION;
51 BEGIN {
52 @EXPORT = qw(create_timed_token verify_timed_token create_token_secret);
53 *VERSION = \'1.0';
56 # Like MIME::Base64::encode_base64 except that the base64url alphabet is used
57 # and no newlines are ever added
58 sub _encode_base64_url {
59 use bytes;
60 my $b64 = encode_base64($_[0], "");
61 # convert standard base64 encoding to the base64url encoding
62 $b64 =~ tr{+/}{-_};
63 return $b64;
66 # Like MIME::Base64::decode_base64 except that the base64url alphabet is used
67 # Same arguments as MIME::Base64::decode_base64
68 sub _decode_base64_url {
69 use bytes;
70 my $b64 = shift;
71 # convert base64url encoding to the standard base64 encoding
72 $b64 =~ tr{-_}{+/};
73 return decode_base64($b64);
76 # Return a new "robust" secret value that can be passed to
77 # create_timed_token as $_[0].
79 # Although any value can be used as a secret, this function
80 # attempts to generate a decently random one with sufficient
81 # entropy to avoid collision attacks.
83 # These are meant to remain "secret" -- any client that manages
84 # to obtain the secret will likely be able to forge tokens.
86 # Since new token secrets are only expected to be created once
87 # in a while and certainly not on every single request, it's
88 # not necessary for this function to be instantaneous.
90 # Note that even though the returned result is in base64url
91 # format, it should be passed as-is to create_timed_token
92 # and verify_timed_token -- there's absolutely no need to
93 # base64url decode it first since it's already guaranteed
94 # to have more than enough bits of entropy in its much more
95 # convenient base64url form.
97 # Note that although rare, the output of this function can
98 # start with '-' or with '_' rather than an alphanumeric.
99 # Make sure it can never be accidentally treated as an option
100 # argument to some utility.
102 sub create_token_secret {
103 # We would like to produce at least 20 bytes worth
104 # of entropy, but returned encoded as base64url for
105 # convenience in loading and storing.
106 # To further mash things up, after collecting enough
107 # random (pseudo-random really) raw bits, pass those
108 # through two different hash functions, concatenate the
109 # result and then base64url encode it.
110 # Using cryptographic quality hash functions will end
111 # up reducing the number of entropy bits to approximately
112 # 63.212% of the number we started with. Therefore we don't
113 # just collect 160 bits (20 * 8), we collect 160 / 0.63212
114 # which we simply round up to 256 bits (32 bytes).
116 # We take input from /dev/urandom if it exists and is
117 # readable (or /dev/random in it's place if that is),
118 # Then add a bunch of rand() results and the few bits
119 # of truly random information available (the pid, the
120 # current time, etc.). In this way, even if /dev/urandom
121 # (or /dev/random) is not available, we can still produce
122 # enough stuff to feed through the hash functions to
123 # get a decent secret.
125 use bytes;
126 my $devrand = undef;
127 -c '/dev/urandom' && -r _ and $devrand = '/dev/urandom';
128 !$devrand && -c '/dev/random' && -r _ and $devrand = '/dev/random';
129 my $input = "";
130 if ($devrand) {
131 # Best source, so always get enough from here
132 # if this source is available.
133 my $drh;
134 if (open($drh, '<', $devrand)) {
135 binmode($drh);
136 while (length($input) < 32) {
137 last unless sysread($drh, $input,
138 32-length($input), length($input));
140 close($drh);
143 for (my $w = 0; $w < 32; $w += 2) {
144 # use rand to get 16 bits at a time
145 $input .= pack('n',int(rand(32768)));
147 # Glue on pid and current time
148 $input .= $$ . time();
149 # And just for kicks, the last mod time of this file
150 my $mod = (stat(__FILE__))[9];
151 defined($mod) and $input .= $mod;
152 # And finally the address of this routine
153 my $ra = refaddr(\&create_token_secret);
154 defined($ra) and $input .= $ra;
155 my $h = sha1($input) . md5($input);
156 return _encode_base64_url($h);
159 # $_[0] -> "secret" to use for HMAC
160 # $_[1] -> optional instance info to include in "text"
161 # $_[2] -> duration of validity in seconds (5..2147483647)
162 # $_[3] -> optional time stamp (secs since unix Epoch)
163 # if not provided, current time is used
164 # Returns a base64_url token (no trailing '='s) that is
165 # valid starting at $_[3] and expires $_[2] seconds after $_[3].
167 sub create_timed_token {
168 use bytes;
169 my $t = $_[3];
170 looks_like_number($t) or $t = time();
171 $t = int($t);
172 my $d = int($_[2]);
173 5 <= $d && $d <= 2147483647 or
174 die "crazy create_timed_token duration: $d";
175 my $tp = int($t / $d);
176 my $to = int($t - ($tp * $d));
177 my $raw = _get_raw_hmac($_[0], $_[1], $tp, $to);
178 if ($to <= 255) {
179 $raw .= pack('C', $to);
180 } else {
181 $raw .= pack('N', $to);
183 return _encode_base64_url($raw);
186 # $_[0] -> a create_timed_token to verify
187 # $_[1] -> "secret" passed to create_timed_token
188 # $_[2] -> instance info passed to create_timed_token
189 # $_[3] -> validity in seconds passed to create_timed_token
190 # $_[4] -> optional time stamp (secs since unix Epoch)
191 # if not provided, current time is used
192 # Returns true if $_[4] falls within the token's validity range
193 # Returns false for a bad or expired token
195 # Forging a token would require knowing the arguments that were
196 # passed to create_timed_token to create it or the ability to
197 # generate cryptographic HMAC collisions.
199 sub verify_timed_token {
200 use bytes;
201 my $tok = shift;
202 # shortest possible token is 28 base64url characters
203 # maximum (if an extremely long period is used) is 32.
204 defined($tok) && $tok =~/^[A-Za-z0-9_-]{28,32}$/ or
205 return undef;
206 # and, in fact, in-between lengths are incorrect too
207 length($tok) == 28 || length($tok) == 32 or
208 return undef;
209 my $raw = _decode_base64_url($tok);
210 defined($raw) && (length($raw) == 21 || length($raw) == 24) or do {
211 warn "_decode_base64_url failed to decode properly";
212 return undef;
214 my $h = substr($raw, 0, 20);
215 my $o;
216 if (length($raw) == 21) {
217 $o = unpack('C', substr($raw, 20, 1));
218 } else {
219 $o = unpack('N', substr($raw, 20, 4));
221 defined($o) or do {
222 warn "failed to unpack offset somehow";
223 return undef;
225 $o = int($o);
226 my $t = $_[3];
227 looks_like_number($t) or $t = time();
228 $t = int($t);
229 my $tp = int($t / int($_[2]));
230 my $test = _get_raw_hmac($_[0], $_[1], $tp, $o);
231 if ($test ne $h) {
232 --$tp;
233 $test = _get_raw_hmac($_[0], $_[1], $tp, $o);
234 $test eq $h or return undef; # definitely no match
236 my $tokbegin = ($tp * int($_[2])) + $o;
237 return $tokbegin <= $t && $t < ($tokbegin + int($_[2]));
240 sub _get_raw_hmac {
241 my ($secret, $extra, $period, $offset) = @_;
242 $period = int($period);
243 $offset = int($offset);
244 my $text = '$TimedToken$'.$extra.'$'.$period.'$'.$offset;
245 return hmac_sha1($text, $secret);