1package Net::OpenID::JanRain::Stores::FileStore; 2 3=head1 JanRain OpenID File Store 4 5This module maintains a directory structure that saves state for the 6JanRain OpenID Library. 7 8=head2 Synopsis: 9 10C<< Net::OpenID::JanRain::Stores::FileStore->new("directory") >> 11 12=cut 13 14# vi:ts=4:sw=4 15 16use warnings; 17use strict; 18 19use Carp; 20use MIME::Base64 qw(encode_base64); 21use File::Spec; 22use File::Temp qw( tempfile ); 23use Net::OpenID::JanRain::CryptUtil qw( sha1 randomString ); 24 25our @ISA = qw( 26 Net::OpenID::JanRain::Stores 27 ); 28 29# Functions 30sub _safe64 { 31 my ($s) = @_; 32 my $h64 = encode_base64(sha1($s)); 33 $h64 =~ s/\+/_/g; 34 $h64 =~ s!/!.!g; 35 $h64 =~ s/=//g; 36 $h64 =~ s/\n//g; 37 return $h64; 38} 39######################################################################## 40sub _isFilenameSafe { 41 my ($c) = @_; 42 return 43} 44######################################################################## 45sub _filenameEscape { 46 my ($s) = @_; 47} 48######################################################################## 49# Attempt to remove a file, returning whether the file existed at 50# the time of the call. 51sub _removeIfPresent { 52 my ($filename) = @_; 53 if ((unlink $filename) == 0) { 54 die "Could not remove $filename. $!" if -e $filename; 55 return 0; 56 } 57 return 1; 58} # end removeIfPresent 59######################################################################## 60# _ensureDir 61# Create dir_name as a directory if it does not exist. If it 62# exists, make sure that it is, in fact, a directory. 63sub _ensureDir { 64 my ($dir_name) = @_; 65 mkdir $dir_name, 0755 66 || -d $dir_name 67 || die "Unable to make directory $dir_name. $!"; 68 return -d $dir_name; 69} # end ensureDir 70######################################################################## 71 72# Methods 73######################################################################## 74# new 75# Call with the directory where the files should go. 76# All files must reside on the same filesystem. 77sub new { 78 my $caller = shift; 79 my ($dir) = @_; 80 my $class = ref($caller) || $caller; 81 $dir = File::Spec->rel2abs($dir); 82 my $noncedir = File::Spec->catdir($dir, "nonces"); 83 my $assocdir = File::Spec->catdir($dir, "associations"); 84 my $tempdir = File::Spec->catdir($dir, "temp"); 85 my $authkeyn = File::Spec->catfile($dir, "auth_key"); 86 my $maxnonceage = 6 * 60 * 60; 87 my $AUTH_KEY_LEN = 20; 88 my $self = {nonce_dir => $noncedir, 89 assoc_dir => $assocdir, 90 temp_dir => $tempdir, 91 auth_key_name => $authkeyn, 92 max_nonce_age => $maxnonceage, 93 AUTH_KEY_LEN => $AUTH_KEY_LEN}; 94 95 _ensureDir($dir); 96 _ensureDir($noncedir); 97 _ensureDir($assocdir); 98 _ensureDir($tempdir); 99 100 bless($self, $class); 101} # end new 102######################################################################## 103# isDumb 104# true if we are a dumb store, which we aren't. 105sub isDumb { 106 my $self = shift; 107 return 0; 108} 109######################################################################## 110# readAuthKey 111# Read the auth key from the auth key file. Will return None 112# if there is currently no key. 113sub readAuthKey { 114 my $self = shift; 115 my $key; 116 open AKF, "< $self->{auth_key_name}" or return undef; 117 # Read one more byte than necessary to detect corruption 118 my $keylen = (read AKF, $key, $self->{AUTH_KEY_LEN}+1); 119 return undef if $keylen == 0; 120 close AKF; 121 return $key; 122} # end readAuthKey 123######################################################################## 124# createAuthKey 125# Generate a new random auth key and safely store it in the 126# location specified by self.auth_key_name. 127sub createAuthKey { 128 my $self = shift; 129 my $auth_key = randomString($self->{AUTH_KEY_LEN}); 130 131 my ($fh, $tmpfn) = tempfile(DIR => $self->{temp_dir}); 132 die "Could not open a temporary file" unless $fh; 133 print $fh $auth_key; 134 close $fh; 135 136 unless(link($tmpfn, $self->{auth_key_name})) { 137 unless(rename ($tmpfn, $self->{auth_key_name})) { 138 $auth_key = $self->readAuthKey(); 139 unless ($auth_key) { 140 die 'Failed to create or read Auth Key' 141 } 142 } 143 } 144 $self->_removeIfPresent($tmpfn); 145 return $auth_key; 146 147} # end createAuthKey 148######################################################################## 149# getAuthKey 150# Retrieve the auth key from the file specified by 151# self.auth_key_name, creating it if it does not exist. 152sub getAuthKey { 153 my $self = shift; 154 my $auth_key = $self->readAuthKey(); 155 $auth_key = $self->createAuthKey() unless $auth_key; 156 if (length($auth_key) != $self->{AUTH_KEY_LEN}) { 157 die "Got invalid auth key from $self->{auth_key_name}. Expected ". 158 "$self->{AUTH_KEY_LEN} byte string. Got: $auth_key"; 159 } 160 return $auth_key; 161} # end getAuthKey 162######################################################################## 163# getAssociationFilename 164# Create a unique filename for a given server url and 165# handle. This implementation does not assume anything about the 166# format of the handle. The filename that is returned will 167# contain the domain name from the server URL for ease of human 168# inspection of the data directory. 169sub getAssociationFilename { 170 my $self = shift; 171 my ($server_url, $handle) = @_; 172 defined($server_url) || die "getAssociationFilename called without server url"; 173 unless($server_url =~ m!(.+)://([.\w]+)/?!) { 174 die "Bad server URL: $server_url"; 175 } 176 my $proto = $1; 177 my $domain = $2; 178 179 my $url_hash = _safe64($server_url); 180 181 my $handle_hash; 182 183 if ($handle) { 184 $handle_hash = _safe64($handle); 185 } 186 else { 187 $handle_hash = ''; 188 } 189 190 my $filename = "${proto}-${domain}-${url_hash}-${handle_hash}"; 191 192 return File::Spec->catfile($self->{assoc_dir}, $filename); 193} # end getAssociationFilename 194######################################################################## 195# storeAssociation 196# Create a unique filename for a given server url and 197# handle. This implementation does not assume anything about the 198# format of the handle. The filename that is returned will 199# contain the domain name from the server URL for ease of human 200# inspection of the data directory. 201sub storeAssociation { 202 my $self = shift; 203 my ($server_url, $association) = @_; 204 205 my $association_s = $association->serialize(); 206 my $filename=$self->getAssociationFilename($server_url, $association->{handle}); 207 my ($fh, $tmpfn) = tempfile(DIR => $self->{temp_dir}); 208 209 unless (print $fh $association_s) { 210 warn "Unable to write association to $tmpfn"; 211 close $fh; 212 return; 213 } 214 # os.fsync(tmp_file.fileno()) 215 close $fh; 216 217 unless (rename $tmpfn, $filename) { 218 unlink $filename; 219 unless (rename $tmpfn, $filename) { 220 warn "Unable to rename $tmpfn to $filename. $!"; 221 unlink $tmpfn; 222 } 223 } 224} # end storeAssociation 225######################################################################## 226# getAssociation 227# Retrieve an association. If no handle is specified, return 228# the association with the latest expiration. 229# If no matching association exists, returns undef 230sub getAssociation { 231 use Net::OpenID::JanRain::Association; 232 my $self = shift; 233 my ($server_url, $handle) = @_; 234 235 defined($handle) or $handle = ''; 236 237 my $filename = $self->getAssociationFilename($server_url, $handle); 238 239 if ($handle) { 240 return $self->_getAssociation($filename); 241 } 242 else { 243 my @associations = (); 244 # The filename with an empty handle is a prefix of all association 245 # filenames for a given server URL. 246 my $file_match = "$filename*"; 247 my $file; 248 for $file (glob($file_match)) { 249 my $assoc = $self->_getAssociation($file); 250 if ($assoc) { 251 push @associations, $assoc; 252 } 253 } 254 @associations = sort {$a->{issued} <=> $b->{issued}} @associations; 255 return pop @associations; # undef if array is empty 256 } 257} # end getAssociation 258######################################################################## 259# _getAssociation 260# Read an association file and return an association object. 261# undef if we have no such association. 262sub _getAssociation { 263 my $self = shift; 264 my ($filename) = @_; 265 266 open FILE, "< $filename" or return undef; 267 268 my $assoc_s; 269 unless (read FILE, $assoc_s, 1024) { #more bytes than needed 270 warn "Unable to read $filename"; 271 close FILE; 272 return undef; 273 } 274 close FILE; 275 my $association = Net::OpenID::JanRain::Association->deserialize($assoc_s); 276 #If we find a bunk association, remove it. 277 _removeIfPresent($filename) unless $association; 278 return $association; 279} 280######################################################################## 281# removeAssociation 282# Remove an association if it exists. Do nothing if it does not. 283sub removeAssociation { 284 my $self = shift; 285 my ($server_url, $handle) = @_; 286 my $assoc = $self->getAssociation($server_url, $handle); 287 if ($assoc) { 288 return _removeIfPresent($self->getAssociationFilename($server_url, $handle)); 289 } 290 return 0; 291} # end removeAssociation 292######################################################################## 293sub storeNonce { 294 my $self = shift; 295 my ($nonce) = @_; 296 my $fn = File::Spec->catfile($self->{nonce_dir}, $nonce); 297 open FILE, "> $fn" or die "Could not open nonce file $fn - $!\n"; 298 close FILE; 299} # end storeNonce 300######################################################################## 301sub useNonce { 302 my $self = shift; 303 my ($nonce) = @_; 304 my $fn = File::Spec->catfile($self->{nonce_dir}, $nonce); 305 my @stats = stat $fn; 306 return undef unless @stats; 307 my $mtime = $stats[10]; 308 unlink $fn || return undef; 309 return (($mtime - time) < $self->{max_nonce_age}); 310} # end useNonce 311######################################################################## 312sub clean { 313 my $self = shift; 314 my $now = time; # now is the time 315 316 # Check all nonces for expiration 317 my $fn; 318 for $fn (glob(File::Spec->catfile($self->{nonce_dir}, "*"))) { 319 my @stats = stat $fn; 320 if (@stats) { 321 # tenth stat is modification time 322 if (($now - $stats[10]) > $self->{max_nonce_age} ) { 323 _removeIfPresent($fn); 324 } 325 } 326 } 327 328 # Check all associations for corruption and expiration 329 for $fn (glob(File::Spec->catfile($self->assoc_dir,"*"))) { 330 my $assoc = _getAssociation($fn); #cleans up corrupted files. 331 if($assoc && $assoc->getExpiresIn() == 0) { 332 _removeIfPresent($fn); 333 } 334 } 335} # end clean 336######################################################################## 3371; 338