Girocco/TimedToken.pm

   1 # Girocco::TimedToken.pm -- HMAC Timed Token Utility Functions
   2 # Copyright (C) 2021 Kyle J. McKay.  All rights reserved.
   3
   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.
   8 #
   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.
  13 #
  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.
  17
  18 package Girocco::TimedToken;
  19
  20 use strict;
  21 use warnings;
  22
  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";
  44 }
  45 use Girocco::HashUtil qw(hmac_sha1);
  46
  47 use base qw(Exporter);
  48 our @EXPORT;
  49 our $VERSION;
  50
  51 BEGIN {
  52         @EXPORT = qw(create_timed_token verify_timed_token create_token_secret);
  53         *VERSION = \'1.0';
  54 }
  55
  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;
  64 }
  65
  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);
  74 }
  75
  76 # Return a new "robust" secret value that can be passed to
  77 # create_timed_token as $_[0].
  78 #
  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.
  82 #
  83 # These are meant to remain "secret" -- any client that manages
  84 # to obtain the secret will likely be able to forge tokens.
  85 #
  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.
  89 #
  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.
  96 #
  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.
 101 #
 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).
 115         #
 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.
 124         #
 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));
 139                         }
 140                         close($drh);
 141                 }
 142         }
 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)));
 146         }
 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);
 157 }
 158
 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].
 166 #
 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);
 182         }
 183         return _encode_base64_url($raw);
 184 }
 185
 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
 194 #
 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.
 198 #
 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;
 213         };
 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));
 220         }
 221         defined($o) or do {
 222                 warn "failed to unpack offset somehow";
 223                 return undef;
 224         };
 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
 235         }
 236         my $tokbegin = ($tp * int($_[2])) + $o;
 237         return $tokbegin <= $t && $t < ($tokbegin + int($_[2]));
 238 }
 239
 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);
 246 }
 247
 248 1;