| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::Raps2; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 748 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 27 |  | 
| 4 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 5 | 1 |  |  | 1 |  | 27 | use 5.010; | 
|  | 1 |  |  |  |  | 3 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 1 |  |  | 1 |  | 476 | use App::Raps2::Password; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 33 |  | 
| 8 | 1 |  |  | 1 |  | 497 | use App::Raps2::UI; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 30 |  | 
| 9 | 1 |  |  | 1 |  | 26 | use Carp qw(cluck confess); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 52 |  | 
| 10 | 1 |  |  | 1 |  | 643 | use Config::Tiny; | 
|  | 1 |  |  |  |  | 849 |  | 
|  | 1 |  |  |  |  | 31 |  | 
| 11 | 1 |  |  | 1 |  | 750 | use File::BaseDir qw(config_home data_home); | 
|  | 1 |  |  |  |  | 1106 |  | 
|  | 1 |  |  |  |  | 64 |  | 
| 12 | 1 |  |  | 1 |  | 4 | use File::Path qw(make_path); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 59 |  | 
| 13 | 1 |  |  | 1 |  | 1209 | use File::Slurp qw(slurp write_file); | 
|  | 1 |  |  |  |  | 4612 |  | 
|  | 1 |  |  |  |  | 1581 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | our $VERSION = '0.54'; | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | sub new { | 
| 18 | 1 |  |  | 1 | 1 | 738 | my ( $class, %opt ) = @_; | 
| 19 | 1 |  |  |  |  | 3 | my $self = {}; | 
| 20 |  |  |  |  |  |  |  | 
| 21 | 1 |  |  |  |  | 4 | $self->{xdg_conf} = config_home('raps2'); | 
| 22 | 1 |  |  |  |  | 30 | $self->{xdg_data} = data_home('raps2'); | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 1 | 50 |  |  |  | 19 | if ( not $opt{no_cli} ) { | 
| 25 | 0 |  |  |  |  | 0 | $self->{ui} = App::Raps2::UI->new(); | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 | 1 |  |  |  |  | 2 | $self->{default} = \%opt; | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 1 |  |  |  |  | 2 | bless( $self, $class ); | 
| 31 |  |  |  |  |  |  |  | 
| 32 | 1 | 50 |  |  |  | 4 | if ( not $opt{dont_touch_fs} ) { | 
| 33 | 1 |  |  |  |  | 3 | $self->sanity_check(); | 
| 34 | 1 |  |  |  |  | 6 | $self->load_config(); | 
| 35 | 1 |  |  |  |  | 5 | $self->load_defaults(); | 
| 36 |  |  |  |  |  |  | } | 
| 37 |  |  |  |  |  |  |  | 
| 38 | 1 | 50 |  |  |  | 5 | if ( $opt{master_password} ) { | 
| 39 | 1 |  |  |  |  | 5 | $self->get_master_password( $opt{master_password} ); | 
| 40 |  |  |  |  |  |  | } | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 1 |  |  |  |  | 9 | return $self; | 
| 43 |  |  |  |  |  |  | } | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | sub file_to_hash { | 
| 46 | 7 |  |  | 7 | 1 | 1296 | my ( $self, $file ) = @_; | 
| 47 | 7 |  |  |  |  | 12 | my $ret; | 
| 48 |  |  |  |  |  |  |  | 
| 49 | 7 |  |  |  |  | 34 | for my $line ( slurp($file) ) { | 
| 50 | 35 |  |  |  |  | 1245 | my ( $key, $value ) = ( $line =~ m{ ^ ([^ ]+) \s+ (.+) $ }x ); | 
| 51 |  |  |  |  |  |  |  | 
| 52 | 35 | 100 | 66 |  |  | 148 | if ( not( $key and $value ) ) { | 
| 53 | 3 |  |  |  |  | 6 | next; | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  |  | 
| 56 | 32 |  |  |  |  | 77 | $ret->{$key} = $value; | 
| 57 |  |  |  |  |  |  | } | 
| 58 | 7 |  |  |  |  | 24 | return $ret; | 
| 59 |  |  |  |  |  |  | } | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | sub sanity_check { | 
| 62 | 1 |  |  | 1 | 1 | 2 | my ($self) = @_; | 
| 63 |  |  |  |  |  |  |  | 
| 64 | 1 |  |  |  |  | 500 | make_path( $self->{xdg_conf}, $self->{xdg_data} ); | 
| 65 |  |  |  |  |  |  |  | 
| 66 | 1 | 50 |  |  |  | 20 | if ( not -e $self->{xdg_conf} . '/password' ) { | 
| 67 | 1 |  |  |  |  | 4 | $self->create_config(); | 
| 68 |  |  |  |  |  |  | } | 
| 69 | 1 | 50 |  |  |  | 33 | if ( not -e $self->{xdg_conf} . '/defaults' ) { | 
| 70 | 1 |  |  |  |  | 7 | $self->create_defaults(); | 
| 71 |  |  |  |  |  |  | } | 
| 72 |  |  |  |  |  |  |  | 
| 73 | 1 |  |  |  |  | 4 | return; | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | sub get_master_password { | 
| 77 | 1 |  |  | 1 | 1 | 3 | my ( $self, $pass ) = @_; | 
| 78 |  |  |  |  |  |  |  | 
| 79 | 1 | 50 |  |  |  | 3 | if ( not defined $pass ) { | 
| 80 | 0 |  |  |  |  | 0 | $pass = $self->ui->read_pw( 'Master Password', 0 ); | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | $self->{pass} = App::Raps2::Password->new( | 
| 84 |  |  |  |  |  |  | cost       => $self->{master_cost}, | 
| 85 |  |  |  |  |  |  | salt       => $self->{master_salt}, | 
| 86 | 1 |  |  |  |  | 12 | passphrase => $pass, | 
| 87 |  |  |  |  |  |  | ); | 
| 88 |  |  |  |  |  |  |  | 
| 89 | 1 |  |  |  |  | 11 | $self->pw->verify( $self->{master_hash} ); | 
| 90 |  |  |  |  |  |  |  | 
| 91 | 1 |  |  |  |  | 4 | return; | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | sub create_config { | 
| 95 | 1 |  |  | 1 | 1 | 3 | my ($self) = @_; | 
| 96 |  |  |  |  |  |  |  | 
| 97 | 1 |  | 50 |  |  | 8 | my $cost = $self->{master_cost} = $self->{default}{cost} // 12; | 
| 98 |  |  |  |  |  |  |  | 
| 99 | 1 |  | 33 |  |  | 6 | my $pass = $self->{default}{master_password} // $self->ui->read_pw( | 
| 100 |  |  |  |  |  |  | 'Running for the first time. Please choose a master password', 1 ); | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | $self->{pass} = App::Raps2::Password->new( | 
| 103 |  |  |  |  |  |  | cost       => $self->{master_cost}, | 
| 104 | 1 |  |  |  |  | 13 | passphrase => $pass, | 
| 105 |  |  |  |  |  |  | ); | 
| 106 |  |  |  |  |  |  |  | 
| 107 | 1 |  |  |  |  | 5 | my $hash = $self->{master_hash} = $self->pw->bcrypt; | 
| 108 | 1 |  |  |  |  | 459604 | my $salt = $self->{master_salt} = $self->pw->salt; | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | write_file( | 
| 111 | 1 |  |  |  |  | 15 | $self->{xdg_conf} . '/password', | 
| 112 |  |  |  |  |  |  | "cost ${cost}\n", | 
| 113 |  |  |  |  |  |  | "salt ${salt}\n", | 
| 114 |  |  |  |  |  |  | "hash ${hash}\n", | 
| 115 |  |  |  |  |  |  | ); | 
| 116 |  |  |  |  |  |  |  | 
| 117 | 1 |  |  |  |  | 408 | return; | 
| 118 |  |  |  |  |  |  | } | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | sub load_config { | 
| 121 | 1 |  |  | 1 | 1 | 2 | my ($self) = @_; | 
| 122 |  |  |  |  |  |  |  | 
| 123 | 1 |  |  |  |  | 7 | my $cfg = $self->file_to_hash( $self->{xdg_conf} . '/password' ); | 
| 124 |  |  |  |  |  |  |  | 
| 125 | 1 |  |  |  |  | 4 | $self->{master_hash} = $cfg->{hash}; | 
| 126 | 1 |  |  |  |  | 2 | $self->{master_salt} = $cfg->{salt}; | 
| 127 | 1 |  |  |  |  | 3 | $self->{master_cost} = $cfg->{cost}; | 
| 128 |  |  |  |  |  |  |  | 
| 129 | 1 |  |  |  |  | 15 | return; | 
| 130 |  |  |  |  |  |  | } | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | sub create_defaults { | 
| 133 | 1 |  |  | 1 | 1 | 2 | my ($self) = @_; | 
| 134 |  |  |  |  |  |  |  | 
| 135 | 1 |  | 50 |  |  | 10 | my $cost      = $self->{default}{cost}      // 12; | 
| 136 | 1 |  | 50 |  |  | 6 | my $pwgen_cmd = $self->{default}{pwgen_cmd} // 'pwgen -s 23 1'; | 
| 137 | 1 |  | 50 |  |  | 5 | my $xclip_cmd = $self->{default}{xclip_cmd} // 'xclip -l 1'; | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | write_file( | 
| 140 | 1 |  |  |  |  | 10 | $self->{xdg_conf} . '/defaults', | 
| 141 |  |  |  |  |  |  | "cost = ${cost}\n", | 
| 142 |  |  |  |  |  |  | "pwgen_cmd = ${pwgen_cmd}\n", | 
| 143 |  |  |  |  |  |  | "xclip_cmd = ${xclip_cmd}\n", | 
| 144 |  |  |  |  |  |  | ); | 
| 145 |  |  |  |  |  |  |  | 
| 146 | 1 |  |  |  |  | 154 | return; | 
| 147 |  |  |  |  |  |  | } | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | sub load_defaults { | 
| 150 | 1 |  |  | 1 | 1 | 2 | my ($self) = @_; | 
| 151 |  |  |  |  |  |  |  | 
| 152 | 1 |  |  |  |  | 18 | my $cfg = Config::Tiny->read( $self->{xdg_conf} . '/defaults' ); | 
| 153 |  |  |  |  |  |  |  | 
| 154 | 1 |  | 33 |  |  | 160 | $self->{default}{cost}      //= $cfg->{_}->{cost}; | 
| 155 | 1 |  | 33 |  |  | 9 | $self->{default}{pwgen_cmd} //= $cfg->{_}->{pwgen_cmd}; | 
| 156 | 1 |  | 33 |  |  | 7 | $self->{default}{xclip_cmd} //= $cfg->{_}->{xclip_cmd}; | 
| 157 |  |  |  |  |  |  |  | 
| 158 | 1 |  |  |  |  | 9 | return; | 
| 159 |  |  |  |  |  |  | } | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | sub conf { | 
| 162 | 3 |  |  | 3 | 1 | 12 | my ( $self, $key ) = @_; | 
| 163 |  |  |  |  |  |  |  | 
| 164 | 3 |  |  |  |  | 18693 | return $self->{default}{$key}; | 
| 165 |  |  |  |  |  |  | } | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | sub pw { | 
| 168 | 13 |  |  | 13 | 1 | 469 | my ($self) = @_; | 
| 169 |  |  |  |  |  |  |  | 
| 170 | 13 | 50 |  |  |  | 47 | if ( defined $self->{pass} ) { | 
| 171 | 13 |  |  |  |  | 118 | return $self->{pass}; | 
| 172 |  |  |  |  |  |  | } | 
| 173 |  |  |  |  |  |  | else { | 
| 174 | 0 |  |  |  |  | 0 | confess( | 
| 175 |  |  |  |  |  |  | 'No App::Raps2::Password object, did you call get_master_password?' | 
| 176 |  |  |  |  |  |  | ); | 
| 177 |  |  |  |  |  |  | } | 
| 178 |  |  |  |  |  |  |  | 
| 179 | 0 |  |  |  |  | 0 | return; | 
| 180 |  |  |  |  |  |  | } | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | sub ui { | 
| 183 | 1 |  |  | 1 | 1 | 9 | my ($self) = @_; | 
| 184 |  |  |  |  |  |  |  | 
| 185 | 1 |  |  |  |  | 5 | return $self->{ui}; | 
| 186 |  |  |  |  |  |  | } | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | sub generate_password { | 
| 189 | 1 |  |  | 1 | 1 | 1133 | my ($self) = @_; | 
| 190 |  |  |  |  |  |  |  | 
| 191 | 1 | 50 |  |  |  | 10 | open( my $pwgen, q{-|}, $self->conf('pwgen_cmd') ) or return; | 
| 192 | 1 |  |  |  |  | 1560 | my $password = ( split( / /, <$pwgen> ) )[0]; | 
| 193 | 1 | 50 |  |  |  | 220 | close($pwgen) or cluck("Cannot close pwgen pipe: $!"); | 
| 194 |  |  |  |  |  |  |  | 
| 195 | 1 |  |  |  |  | 8 | chomp $password; | 
| 196 |  |  |  |  |  |  |  | 
| 197 | 1 |  |  |  |  | 65 | return $password; | 
| 198 |  |  |  |  |  |  | } | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | sub pw_save { | 
| 201 | 2 |  |  | 2 | 1 | 14 | my ( $self, %data ) = @_; | 
| 202 |  |  |  |  |  |  |  | 
| 203 | 2 |  | 66 |  |  | 18 | $data{file}  //= $self->{xdg_data} . "/$data{name}"; | 
| 204 | 2 |  | 100 |  |  | 12 | $data{login} //= q{}; | 
| 205 | 2 |  | 33 |  |  | 16 | $data{salt}  //= $self->pw->create_salt(); | 
| 206 | 2 |  | 100 |  |  | 28 | $data{url}   //= q{}; | 
| 207 | 2 |  | 33 |  |  | 16 | $data{cost}  //= $self->{default}{cost}; | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | my $pass_hash = $self->pw->encrypt( | 
| 210 |  |  |  |  |  |  | data => $data{password}, | 
| 211 |  |  |  |  |  |  | salt => $data{salt}, | 
| 212 |  |  |  |  |  |  | cost => $data{cost}, | 
| 213 | 2 |  |  |  |  | 6 | ); | 
| 214 |  |  |  |  |  |  | my $extra_hash = ( | 
| 215 |  |  |  |  |  |  | $data{extra} | 
| 216 |  |  |  |  |  |  | ? $self->pw->encrypt( | 
| 217 |  |  |  |  |  |  | data => $data{extra}, | 
| 218 |  |  |  |  |  |  | salt => $data{salt}, | 
| 219 |  |  |  |  |  |  | cost => $data{cost}, | 
| 220 |  |  |  |  |  |  | ) | 
| 221 | 2 | 100 |  |  |  | 2608 | : q{} | 
| 222 |  |  |  |  |  |  | ); | 
| 223 |  |  |  |  |  |  |  | 
| 224 |  |  |  |  |  |  | write_file( | 
| 225 |  |  |  |  |  |  | $data{file}, | 
| 226 | 2 |  |  |  |  | 1350 | "url $data{url}\n", | 
| 227 |  |  |  |  |  |  | "login $data{login}\n", | 
| 228 |  |  |  |  |  |  | "cost $data{cost}\n", | 
| 229 |  |  |  |  |  |  | "salt $data{salt}\n", | 
| 230 |  |  |  |  |  |  | "hash ${pass_hash}\n", | 
| 231 |  |  |  |  |  |  | "extra ${extra_hash}\n", | 
| 232 |  |  |  |  |  |  | ); | 
| 233 |  |  |  |  |  |  |  | 
| 234 | 2 |  |  |  |  | 808 | return; | 
| 235 |  |  |  |  |  |  | } | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | sub pw_load { | 
| 238 | 3 |  |  | 3 | 1 | 1142 | my ( $self, %data ) = @_; | 
| 239 |  |  |  |  |  |  |  | 
| 240 | 3 |  | 66 |  |  | 25 | $data{file} //= $self->{xdg_data} . "/$data{name}"; | 
| 241 |  |  |  |  |  |  |  | 
| 242 | 3 |  |  |  |  | 14 | my $key = $self->file_to_hash( $data{file} ); | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | # $self->{default}{cost} is the normal way, but older password files | 
| 245 |  |  |  |  |  |  | # (created before the custom cost support) do not have a cost field and | 
| 246 |  |  |  |  |  |  | # use the one of the master password | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  | return { | 
| 249 |  |  |  |  |  |  | url      => $key->{url}, | 
| 250 |  |  |  |  |  |  | login    => $key->{login}, | 
| 251 |  |  |  |  |  |  | cost     => $key->{cost} // $self->{master_cost}, | 
| 252 |  |  |  |  |  |  | password => $self->pw->decrypt( | 
| 253 |  |  |  |  |  |  | data => $key->{hash}, | 
| 254 |  |  |  |  |  |  | salt => $key->{salt}, | 
| 255 |  |  |  |  |  |  | cost => $key->{cost} // $self->{master_cost}, | 
| 256 |  |  |  |  |  |  | ), | 
| 257 |  |  |  |  |  |  | salt  => $key->{salt}, | 
| 258 |  |  |  |  |  |  | extra => ( | 
| 259 |  |  |  |  |  |  | $key->{extra} | 
| 260 |  |  |  |  |  |  | ? $self->pw->decrypt( | 
| 261 |  |  |  |  |  |  | data => $key->{extra}, | 
| 262 |  |  |  |  |  |  | salt => $key->{salt}, | 
| 263 |  |  |  |  |  |  | cost => $key->{cost} // $self->{master_cost}, | 
| 264 |  |  |  |  |  |  | ) | 
| 265 | 3 | 100 | 33 |  |  | 24 | : undef | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
| 266 |  |  |  |  |  |  | ), | 
| 267 |  |  |  |  |  |  | }; | 
| 268 |  |  |  |  |  |  | } | 
| 269 |  |  |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | sub pw_load_info { | 
| 271 | 2 |  |  | 2 | 1 | 8 | my ( $self, %data ) = @_; | 
| 272 |  |  |  |  |  |  |  | 
| 273 | 2 |  | 33 |  |  | 11 | $data{file} //= $self->{xdg_data} . "/$data{name}"; | 
| 274 |  |  |  |  |  |  |  | 
| 275 | 2 |  |  |  |  | 9 | my $key = $self->file_to_hash( $data{file} ); | 
| 276 |  |  |  |  |  |  |  | 
| 277 |  |  |  |  |  |  | return { | 
| 278 |  |  |  |  |  |  | url   => $key->{url}, | 
| 279 |  |  |  |  |  |  | login => $key->{login}, | 
| 280 |  |  |  |  |  |  | salt  => $key->{salt}, | 
| 281 |  |  |  |  |  |  | cost  => $key->{cost}, | 
| 282 | 2 |  |  |  |  | 24 | }; | 
| 283 |  |  |  |  |  |  | } | 
| 284 |  |  |  |  |  |  |  | 
| 285 |  |  |  |  |  |  | 1; | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | __END__ |