#!/usr/bin/env perl

use common::sense;

use Data::Dumper;
use Digest::MD5 'md5_hex';
use Getopt::Long;
use MIME::Base64 qw/decode_base64 encode_base64/;
use List::MoreUtils 'zip';
use POSIX 'ceil';

my @BASE62_CHARS = ('0'..'9', 'a'..'z', 'A'..'Z');
my %BASE62_CODES = map { $BASE62_CHARS[$_] => $_ } 0..$#BASE62_CHARS;

my $COOKIE_L_FIELDS_NUMBER     = 5;
my $COOKIE_L_DATA_LENGTH       = 64;
my $COOKIE_L_HEADER_LENGTH     = 4;
my $COOKIE_L_LOGIN_PART_OFFSET = 24;
my @COLUMNS = qw/encoded_data time key_id random signature/;

my ($uid, $login, $key_id, $key_body, $value, $help);

sub parse {
    my ($value) = @_;

    my @fields = split /\./, $value;

    die 'invalid number of fields'
      unless scalar @fields == $COOKIE_L_FIELDS_NUMBER;

    my %result = zip @COLUMNS, @fields;
    $result{encoded_data} =~ tr/ /+/;

    return %result;
}

sub decode {
    my (%fields) = @_;

    die 'unknown key_body'
      unless $fields{key_body};

    my $base = join '.', @fields{qw/encoded_data time key_id random/};
    $base .= $fields{key_body};

    my $real_signature = md5_hex $base;

    die 'invalid signature'
      unless $real_signature eq $fields{signature};

    my $decoded_data = decode_base64 $fields{encoded_data};
    my $data = xor_text($decoded_data, $fields{key_body});

    my $version = substr($fields{random}, 0, 1);

    my $header = substr $data, 0, $COOKIE_L_HEADER_LENGTH;
    my @header = split //, $header;
    my ($uid_junk_length, $uid_length, $login_junk_length, $login_length)
      = map { $BASE62_CODES{$_} } @header;

    my $uid_offset   = $COOKIE_L_HEADER_LENGTH     + $uid_junk_length;
    my $login_offset = $COOKIE_L_LOGIN_PART_OFFSET + $login_junk_length;

    my $uid   = substr $data, $uid_offset,   $uid_length;

    my $login
      = $version < 3
      ? substr($data, $login_offset, $login_length)
      : substr($data, $login_offset);

    my $uid_junk   = substr $data, $COOKIE_L_HEADER_LENGTH,     $uid_junk_length;
    my $login_junk = substr $data, $COOKIE_L_LOGIN_PART_OFFSET, $login_junk_length;

    my %result = (
        uid     => $uid,
        login   => $login,
        time    => $fields{time},
        version => $version,
        decoded => $decoded_data,
        data    => $data,
        uid_junk_length   => $uid_junk_length,
        login_junk_length => $login_junk_length,
        uid_length   => $uid_length,
        login_length => $login_length,
        uid_offset   => $uid_offset,
        login_offset => $login_offset,
        uid_junk     => $uid_junk,
        login_junk   => $login_junk,
    );

    return %result;
}

sub encode {
    my (%fields) = @_;

    # Create positioned linfo string
    my $lkeyid = $fields{key_id};
    my $lkey   = $fields{key_body};
    my $l1 = length($fields{uid});
    my $l2 = 0;
    my $add1 = 0;
    my $add2 = 0;
    my $p1 = int(rand $add1);
    my $p2 = int(rand $add2);
    my $l_info = '';
    #Encode length param
    for my $i ($p1, $l1, $p2, $l2) {
        $l_info .= (0..9, 'a'..'z', 'A'..'Z')[$i];
    }
    #Add to Cookies uid and length + some randoms
    for (my $i = 0; $i < $p1; $i++){ 
        $l_info .= (0..9)[rand 10];
    }
    $l_info .= $uid;
    while ( length($l_info) < 24 ){
        $l_info .= (0..9)[rand 10];
    }
    for (my $i = 0; $i < $p2; $i++){
        $l_info .= (0..9, 'a'..'z')[rand 36];
    }
    $l_info .= $login;

    # Crypt, pack and sign linfo string
    $l_info = xor_text($l_info, $lkey);
    $l_info = encode_base64($l_info, '');

    $l_info .= "." . time() . "." . $lkeyid . ".3" . int(rand(100000)); # "3" is a version of L cookie
    my $md5 = md5_hex($l_info.$lkey);
    $l_info .= '.' . $md5;
    return $l_info;   
}

sub xor_text {
    my ($text, $key) = @_;

    my $text_length = length $text;
    my $key_length  = length $key;

    my $multiplier = ceil($text_length / $key_length);

    my $extended_key = substr $key x $multiplier, 0, $text_length;
 
    my $result = $text ^ $extended_key;

    return $result;
}

sub options {
    GetOptions(
        'value|cookie|v|c=s' => \$value,
        'uid|u=i'            => \$uid,
        'login|l=s'          => \$login,
        'keyid|i=i'          => \$key_id,
        'keybody|k=s'        => \$key_body,
        'help|h'             => \$help,
    );

    usage() if $help;
}

sub usage {
    print <<EOF;
usage:
  $0 -v <cookie_L_value> [-k <key_body>] - parse and decode (if key body is specified)
  $0 -u <uid> -l <login> -i <key_id> -k <key_body> - encode
EOF
    exit;
}

options();

if ($value) {
    my %fields = parse($value);
    print Data::Dumper->Dump([\%fields], ['fields']);

    if ($key_body) {
        $fields{key_body} = $key_body;
        my %result = decode(%fields);
        print Data::Dumper->Dump([\%result], ['content']);
    }
}
elsif ($uid and $login and $key_id and $key_body) {
    $value = encode(
        uid      => $uid,
        login    => $login,
        key_id   => $key_id,
        key_body => $key_body,
    );
    print $value, "\n";
}
else {
    usage();
}

