1use strict; 2use warnings; 3 4package Config::Identity; 5# ABSTRACT: Load (and optionally decrypt via GnuPG) user/pass identity information 6 7our $VERSION = '0.0019'; 8 9use Carp; 10use IPC::Run qw/ start finish /; 11use File::HomeDir(); 12use File::Spec; 13 14our $home = File::HomeDir->home; 15{ 16 my $gpg; 17 sub GPG() { $ENV{CI_GPG} || ( $gpg ||= do { 18 require File::Which; 19 $gpg = File::Which::which( $_ ) and last for qw/ gpg gpg2 /; 20 $gpg; 21 } ) } 22} 23sub GPG_ARGUMENTS() { $ENV{CI_GPG_ARGUMENTS} || '' } 24 25# TODO Do not even need to do this, since the file is on disk already... 26sub decrypt { 27 my $self = shift; 28 my $file = shift; 29 30 my $gpg = GPG or croak "Missing gpg"; 31 my $gpg_arguments = GPG_ARGUMENTS; 32 my $run; 33 # Old versions, please ignore 34 #$run = "$gpg $gpg_arguments -qd --no-tty --command-fd 0 --status-fd 1"; 35 #$run = "$gpg $gpg_arguments -qd --no-tty --command-fd 0"; 36 $run = "$gpg $gpg_arguments -qd --no-tty"; 37 my @run = split m/\s+/, $run; 38 push @run, $file; 39 my $process = start( \@run, '>pipe', \*OUT, '2>pipe', \*ERR ); 40 my $output = join '', <OUT>; 41 my $_error = join '', <ERR>; 42 finish $process; 43 return ( $output, $_error ); 44} 45 46sub best { 47 my $self = shift; 48 my $stub = shift; 49 my $base = shift; 50 $base = $home unless defined $base; 51 52 croak "Missing stub" unless defined $stub && length $stub; 53 54 for my $i0 ( ".$stub-identity", ".$stub" ) { 55 for my $i1 ( "." ) { 56 my $path = File::Spec->catfile( $base, $i1, $i0 ); 57 return $path if -f $path; 58 } 59 } 60 61 return ''; 62} 63 64sub read { 65 my $self = shift; 66 my $file = shift; 67 68 croak "Missing file" unless -f $file; 69 croak "Cannot read file ($file)" unless -r $file; 70 71 my $binary = -B $file; 72 73 open my $handle, $file or croak $!; 74 binmode $handle if $binary; 75 local $/ = undef; 76 my $content = <$handle>; 77 close $handle or warn $!; 78 79 if ( $binary || $content =~ m/----BEGIN PGP MESSAGE----/ ) { 80 my ( $_content, $error ) = $self->decrypt( $file ); 81 if ( $error ) { 82 carp "Error during decryption of content" . $binary ? '' : "\n$content"; 83 croak "Error during decryption of $file:\n$error"; 84 } 85 $content = $_content; 86 } 87 88 return $content; 89} 90 91sub parse { 92 my $self = shift; 93 my $content = shift; 94 95 return unless $content; 96 my %content; 97 for ( split m/\n/, $content ) { 98 next if /^\s*#/; 99 next unless m/\S/; 100 next unless my ($key, $value) = /^\s*(\w+)\s+(.+)$/; 101 $content{$key} = $value; 102 } 103 return %content; 104} 105 106sub load_best { 107 my $self = shift; 108 my $stub = shift; 109 110 croak "Unable to find .$stub-identity or .$stub" unless my $path = $self->best( $stub ); 111 return $self->load( $path ); 112} 113 114sub try_best { 115 my $self = shift; 116 my $stub = shift; 117 118 return unless my $path = $self->best( $stub ); 119 return $self->load( $path ); 120} 121 122sub load { 123 my $self = shift; 124 my $file = shift; 125 126 return $self->parse( $self->read( $file ) ); 127} 128 129sub load_check { 130 my $self = shift; 131 my $stub = shift; 132 my $required = shift || []; 133 134 my %identity = $self->load_best($stub); 135 my @missing; 136 if ( ref $required eq 'ARRAY' ) { 137 @missing = grep { ! defined $identity{$_} } @$required; 138 } 139 elsif ( ref $required eq 'CODE' ) { 140 local $_ = \%identity; 141 @missing = $required->(\%identity); 142 } 143 else { 144 croak "Argument to check keys must be an arrayref or coderef"; 145 } 146 147 if ( @missing ) { 148 my $inflect = @missing > 1 ? "fields" : "field"; 149 croak "Missing required ${inflect}: @missing" 150 } 151 152 return %identity; 153} 154 1551; 156 157__END__ 158 159=pod 160 161=encoding UTF-8 162 163=head1 NAME 164 165Config::Identity - Load (and optionally decrypt via GnuPG) user/pass identity information 166 167=head1 VERSION 168 169version 0.0019 170 171=head1 SYNOPSIS 172 173PAUSE: 174 175 use Config::Identity::PAUSE; 176 177 # 1. Find either $HOME/.pause-identity or $HOME/.pause 178 # 2. Decrypt the found file (if necessary), read, and parse it 179 # 3. Throw an exception unless %identity has 'user' and 'password' defined 180 181 my %identity = Config::Identity::PAUSE->load_check; 182 print "user: $identity{user} password: $identity{password}\n"; 183 184GitHub API: 185 186 use Config::Identity::GitHub; 187 188 # 1. Find either $HOME/.github-identity or $HOME/.github 189 # 2. Decrypt the found file (if necessary) read, and parse it 190 # 3. Throw an exception unless %identity has 'login' and 'token' defined 191 192 my %identity = Config::Identity::PAUSE->load_check; 193 print "login: $identity{login} token: $identity{token}\n"; 194 195=head1 DESCRIPTION 196 197Config::Identity is a tool for loading (and optionally decrypting via GnuPG) user/pass identity information 198 199For GitHub API access, an identity is a C<login>/C<token> pair 200 201For PAUSE access, an identity is a C<user>/C<password> pair 202 203=head1 USAGE 204 205=head2 %identity = Config::Identity->load_best( <stub> ) 206 207First attempt to load an identity from $HOME/.<stub>-identity 208 209If that file does not exist, then attempt to load an identity from $HOME/.<stub> 210 211The file may be optionally GnuPG encrypted 212 213%identity will be populated like so: 214 215 <key> <value> 216 217For example: 218 219 username alice 220 password hunter2 221 222If an identity file can't be found or read, the method croaks. 223 224=head2 %identity = Config::Identity->load_check( <stub>, <checker> ) 225 226Works like C<load_best> but also checks for required keys. The C<checker> 227argument must be an array reference of B<required> keys or a code reference 228that takes a hashref of key/value pairs from the identity file and returns 229a list of B<missing> keys. For convenience, the hashref will also be 230placed in C<$_>. 231 232If any keys are found missing, the method croaks. 233 234=head1 Using a custom C<gpg> or passing custom arguments 235 236You can specify a custom C<gpg> executable by setting the CI_GPG environment variable 237 238 export CI_GPG="$HOME/bin/gpg" 239 240You can pass custom arguments by setting the CI_GPG_ARGUMENTS environment variable 241 242 export CI_GPG_ARGUMENTS="--no-secmem-warning" 243 244=head1 Encrypting your identity information with GnuPG 245 246If you've never used GnuPG before, first initialize it: 247 248 # Follow the prompts to create a new key for yourself 249 gpg --gen-key 250 251To encrypt your GitHub identity with GnuPG using the above key: 252 253 # Follow the prompts, using the above key as the "recipient" 254 # Use ^D once you've finished typing out your authentication information 255 gpg -ea > $HOME/.github 256 257=head1 Caching your GnuPG secret key via gpg-agent 258 259Put the following in your .*rc 260 261 if which gpg-agent 1>/dev/null 262 then 263 if test -f $HOME/.gpg-agent-info && \ 264 kill -0 `cut -d: -f 2 $HOME/.gpg-agent-info` 2>/dev/null 265 then 266 . "${HOME}/.gpg-agent-info" 267 export GPG_AGENT_INFO 268 else 269 eval `gpg-agent --daemon --write-env-file "${HOME}/.gpg-agent-info"` 270 fi 271 else 272 fi 273 274=head1 PAUSE identity format 275 276 user <user> 277 password <password> 278 279C<username> can also be used as alias for C<user> 280 281=head1 GitHub identity format 282 283 login <login> 284 token <token> 285 286=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan 287 288=head1 SUPPORT 289 290=head2 Bugs / Feature Requests 291 292Please report any bugs or feature requests through the issue tracker 293at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Config-Identity>. 294You will be notified automatically of any progress on your issue. 295 296=head2 Source Code 297 298This is open source software. The code repository is available for 299public review and contribution under the terms of the license. 300 301L<https://github.com/dagolden/Config-Identity> 302 303 git clone https://github.com/dagolden/Config-Identity.git 304 305=head1 AUTHOR 306 307Robert Krimen <robertkrimen@gmail.com> 308 309=head1 CONTRIBUTOR 310 311=for stopwords David Golden 312 313David Golden <dagolden@cpan.org> 314 315=head1 COPYRIGHT AND LICENSE 316 317This software is copyright (c) 2010 by Robert Krimen. 318 319This is free software; you can redistribute it and/or modify it under 320the same terms as the Perl 5 programming language system itself. 321 322=cut 323