#!/usr/bin/perl

# This is a perl script to decrypt gnome keyring-file.
# 
# Copyright (C) 2016 dyknon
# 
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as
# published by the Free Software Foundation,
# either version 3 of the License, or any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
# 
# If you don't have a copy of the GNU General Public License,
# see <http://www.gnu.org/licenses/>.

# usage: gunkeyring.pl [-f filename] [-n name] [-a key=value] [-d]
#
# -f: give a keyring file to open. If no -f option, STDIN is used.
# -n: name of secret value to show.
# -a: attribute of secret value to show.
# -d: turn on file dump mode.
#
# It doesn't show a secret value without -n or -a options.
# -d option only shows names and attributes.
#
# The file format is described in
# https://wiki.gnome.org/Projects/GnomeKeyring/KeyringFormats/FileFormat
#
# If the file have a value-type != 0, this script cannot read it.
# This script does not check any hash values.

use warnings;
use strict;
use Time::Piece;
use Crypt::CBC;
use Crypt::Cipher::AES;
use Crypt::Digest::SHA256;
use Term::ReadKey;
use Getopt::Std;

package fistream;
sub new{
    my $class = shift;
    my $self = {fh=>shift};
    return bless($self, $class);
}
sub read{
    my $self = shift;
    my $size = shift;
    my $buf;
    read($self->{fh}, $buf, $size) == $size || shift || die;
    return $buf;
}

package cistream;
sub new{
    my $class = shift;
    my $self = {st=>shift,cr=>shift,buf=>""};
    $self->{bs} = $self->{cr}->blocksize();
    return bless($self, $class);
}
sub read{
    my $self = shift;
    my $size = shift;
    while($size - length($self->{buf}) > 0){
        my $buf = $self->{st}->read($self->{bs}, 1);
        if(length($buf)){
            $self->{buf} .= $self->{cr}->crypt($buf);
        }else{
            $self->{buf} .= $self->{cr}->finish();
            die if($size - length($self->{buf}) > 0);
        }
    }
    my $ret = substr($self->{buf}, 0, $size);
    $self->{buf} = substr($self->{buf}, $size);
    return $ret;
}

package main;
sub read_guint32{
    my $s = shift || die;

    return unpack("L>", $s->read(4));
}

sub read_time_t{
    my $s = shift || die;

    return localtime(unpack("Q>", $s->read(8)));
}

sub read_string{
    my $s = shift || die;

    my $size = read_guint32($s);
    if($size == 0xffffffff){
        return undef;
    }

    return $s->read($size);
}

sub read_bytes{
    my $s = shift || die;
    my $size = shift || die;

    return $s->read($size);
}

sub read_poi{
    read_bytes(shift, shift);
}

sub read_head{
    my $s = shift || die;
    my $buf;
    my $cor = "GnomeKeyring\n\r\0\n\0\0\0\0";
    if($s->read(length($cor)) eq $cor){
        return 1;
    }else{
        return 0;
    }
}
our $dump_sw = 0;
sub dprint{
    print shift if($dump_sw);
}

ReadMode("noecho");
print STDERR ("Input the password to decrypt this keyring: ");
my $pass = <STDIN>;
print("\n");
ReadMode("restore");
chomp $pass;

my %args;
getopts("dn:a:f:", \%args);

$dump_sw = $args{d};

my $fh = \*STDIN;
if($args{f}){
    open($fh, "<:raw", $args{f}) || die;
}
my $s = fistream->new($fh);
if(read_head($s) != 1){
    die "unknown format";
}
dprint("name: ".read_string($s)."\n");
dprint("ctime: ".read_time_t($s)."\n");
dprint("mtime: ".read_time_t($s)."\n");
dprint("flags: ".read_guint32($s)."\n");
dprint("lock_timeout: ".read_guint32($s)."\n");
my $inter = read_guint32($s);
dprint("hash_interations: ".$inter."\n");
my $salt = read_bytes($s, 8);
my $salthex = $salt;
$salthex =~ s/(.)/sprintf("%02x", ord($1))/ge;
dprint("salt: ".$salthex."\n");
read_poi($s, 4 * 4);

my $num_items = read_guint32($s);
dprint("$num_items items here\n");
for(my $i = 0; $i < $num_items; $i++){
    dprint(" id:".read_guint32($s)."\n");
    dprint(" type:".read_guint32($s)."\n");
    my $num_attr = read_guint32($s);
    for(my $j = 0; $j < $num_attr; $j++){
        dprint("  attr:".read_string($s)."\n");
        my $at = read_guint32($s);
        dprint("  type:".$at."\n");
        if($at == 0){
            dprint("  hash:".read_string($s)."\n");
        }else{
            die "unknown attr type:$at";
        }
    }
}

my $enc_size = read_guint32($s);
dprint("encrypted size:".$enc_size."\n");
die if($enc_size % 16);
my $dseed = $pass . $salt;
my $digest_context = Crypt::Digest::SHA256->new();
my $digest = "";
my $iv = "";
my $key = "";
while(length($iv) < 16 || length($key) < 16){
    $digest_context->reset();
    $digest_context->add($digest);
    $digest_context->add($dseed);
    $digest = $digest_context->digest();
    for(my $i = 1; $i < $inter; $i++){
        $digest_context->reset();
        $digest_context->add($digest);
        $digest = $digest_context->digest();
    }
    $iv .= $digest if(length($iv) < 16);
    $iv = substr($iv, 0, 16) if(length($iv) > 16);
    $key .= $digest if(length($key) < 16);
    $key = substr($key, 0, 16) if(length($key) > 16);
}

my $crypt_context = Crypt::CBC->new(-cipher=>"Cipher::AES",
                                    -key=>$key,
                                    -iv=>$iv,
                                    -header=>"none",
                                    -literal_key=>1,
                                    -keysize=>16,
                                    -blocksize=>16);
$crypt_context->start("dec");
my $ds = cistream->new($s, $crypt_context);
read_poi($ds, 16);
dprint("encrypted:\n");
for(my $i = 0; $i < $num_items; $i++){
    my $name = read_string($ds);
    my $tgt = 0;
    local $dump_sw;
    if($args{n} && $args{n} eq $name){
        $dump_sw = 1;
        $tgt = 1;
    }
    dprint(" name: ".$name."\n");
    my $secret = read_string($ds);
    dprint(" ctime: ".read_time_t($ds)."\n");
    dprint(" mtime: ".read_time_t($ds)."\n");
    read_string($ds);
    read_poi($ds, 4 * 4);
    my $na = read_guint32($ds);
    dprint(" attrs(".$na.")\n");
    for(my $j = 0; $j < $na; $j++){
        my $aname = read_string($ds);
        dprint("  name:".$aname."\n");
        my $at = read_guint32($ds);
        dprint("  type:".$at."\n");
        if($at == 0){
            my $aval = read_string($ds);
            dprint("  value:".$aval."\n");
            if($args{a} && $args{a} eq "$aname=$aval"){
                $tgt = 1;
            }
        }else{
            die "unknown attr type:$at";
        }
    }
    my $nc = read_guint32($ds);
    dprint(" acls(".$nc.")\n");
    for(my $j = 0; $j < $nc; $j++){
        dprint("  types_allowed:".read_guint32($ds)."\n");
        dprint("  name:".read_string($ds)."\n");
        dprint("  pathname:".read_string($ds)."\n");
        read_string($ds);
        read_poi($ds, 4);
    }
    if($tgt){
        print(" name: ".$name."\n");
        print(" secret: ".$secret."\n");
    }
}

close($fh);