view release on metacpan or  search on metacpan

lib/HTTP/Cookies/ChromeMacOS.pm  view on Meta::CPAN

use base qw( HTTP::Cookies );

use constant TRUE  => 1;
use constant FALSE => 0;

my ( $dbh, $pass );

sub _get_dbh {
  my ( $self, $file ) = @_;
  return $dbh if $dbh && $dbh->ping;
  $dbh = DBI->connect( "dbi:SQLite:dbname=$file", '', '',
    {
      sqlite_see_if_its_a_number => 1,
    }
  );

  return $dbh;
}

sub _get_rows {
  my( $self, $file, $domain ) = @_;
  $domain ||= '';

  my $dbh = $self->_get_dbh( $file );

  my @cols = qw/
    creation_utc
    host_key
    name
    value
    encrypted_value
    path
    expires_utc
    secure
    httponly
    last_access_utc
  /;

  my $sql = 'SELECT ' . join( ', ',  @cols ) . ' FROM cookies WHERE host_key like "%' . $domain . '%"';
  my $sth = $dbh->prepare( $sql );
  $sth->execute;

  my @rows = map { bless $_, 'HTTP::Cookies::Chrome::Record' } @{ $sth->fetchall_arrayref };
  $dbh->disconnect;

  return \@rows;
}

sub load {
  my( $self, $file, $domain ) = @_;

  $file ||= $self->{'file'} || return;


  my $salt = 'saltysalt';
  my $iv = ' ' x 16;
  my $salt_len = 16;
  my $pass = _get_pass();
  my $iterations = 1003;

  my $key = derive( 'SHA-1', $pass, $salt, $iterations, $salt_len );


  my $cipher = Crypt::CBC->new(
    -cipher => 'Crypt::OpenSSL::AES',
    -key    => $key,
    -keysize => 16,
    -iv => $iv,
    -header => 'none',
    -literal_key => 1,
  );

  foreach my $row ( @{ $self->_get_rows( $file, $domain ) } ) {
    my $value = $row->value || $row->encrypted_value || '';
    if ( $value =~ /^v10/ ) {
      $value =~ s/^v10//;
      $value = $cipher->decrypt( $value );
    }

    $self->set_cookie(
      undef,
      $row->name,
      $value,
      $row->path,
      $row->host_key,
      undef,
      undef,
      $row->secure,
      time() + 86400, # never expires for readonly
      0,
      {}
    );
  }

  return 1;
}

sub _get_pass {
  # On Mac, replace password from keychain
  # On Linux, replace password with 'peanuts'
  return $pass if $pass;
  $pass = `security find-generic-password -w -s "Chrome Safe Storage"`;
  chomp( $pass );
  return $pass;
}

sub save {
  my( $self, $new_file ) = @_;

  # never save, This is a ReadOnly Version
  return;
}

sub _filter_cookies {
  my( $self ) = @_;

  $self->scan(
    sub {
      my( $version, $key, $val, $path, $domain, $port,
        $path_spec, $secure, $expires, $discard, $rest ) = @_;