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