MToken
view release on metacpan or search on metacpan
make
make test
make install
make clean
Coming soon...
REQUIREMENTS
* openssl
* gpg
lib/MToken.pm view on Meta::CPAN
=item output
The data from program
=back
=head2 get_fingerprint
Returns the fingerprint from local config or ask it
=head2 get_gpgbin
Returns the GNUPG path from local config
=head2 get_manifest
Returns manifest of current token
=head2 get_name
Returns name of current token
lib/MToken.pm view on Meta::CPAN
}
return $self->raise("Program openssl not found. Please install it and try again later") unless $out;
unless ($out =~ /^OpenSSL\s+[1-9]\.[0-9]/m) {
say STDERR yellow("OpenSSL Version is not correctly. May be some problems");
say cyan($out) if $self->verbosemode;
}
}
$self->lconfig->set(opensslbin => $opensslbin);
# Ask GnuPG
my $gpgbin = $self->cli_prompt('GnuPG (gpg) program:', $self->lconfig->get("ogpgbin") ||
$self->conf("gpgbin") || which(GPGBIN) || GPGBIN);
unless ($gpgbin) {
return $self->raise("Program GnuPG (gpg) not found. Please install it and try again later");
} else {
my $cmd = [$gpgbin, "--version"];
my $err = "";
my $out = CTK::Util::execute( $cmd, undef, \$err );
if ($err) {
say cyan("#", join(" ", @$cmd));
say STDERR red($err);
}
return $self->raise("Program GnuPG (gpg) not found. Please install it and try again later") unless $out;
unless ($out =~ /^gpg\s+\(GnuPG\)\s+[2-9]\.[0-9]/m) {
say STDERR yellow("GnuPG Version is not correctly. May be some problems");
say cyan($out) if $self->verbosemode;
}
}
$self->lconfig->set(gpgbin => $gpgbin);
# Ask fingerprint
my $fingerprint = $self->get_fingerprint;
$self->lconfig->set(fingerprint => $fingerprint) if $fingerprint;
# Server URL (server_url)
my $default_url = _get_default_url($tkn);
my $server_url = $self->cli_prompt('Server URL:', MToken::Util::hide_pasword($self->lconfig->get("server_url")
|| $self->conf("server_url") || $default_url, 1));
my $uri = URI->new( $server_url );
lib/MToken.pm view on Meta::CPAN
? $db_info{subject}
: decode(locale => $self->cli_prompt('Subject (commas, slash or backslash is as line delimiter):', encode(locale => $db_info{subject} || "")));
# Ask tags
my $tags = $self->option("force")
? $db_info{tags}
: decode(locale => $self->cli_prompt('Tags (commas or spaces are tag delimiter):', encode(locale => $db_info{tags} || "")));
# New filename
my $out_file = File::Spec->catfile($self->tempdir, sprintf("%s.gpg", $fname));
#say $out_file;
# Encrypt file to tempdir
my %exest = $self->execmd($self->get_gpgbin, "--encrypt", "--armor", "--quiet", "--recipient", $fingerprint, "--output", $out_file, $in_file);
unless ($exest{status} && -f $out_file) {
$self->raise("Can't encrypt file %s", $in_file);
next;
}
# Get path object
my $out_file_path = path($out_file);
# Add/Set new record
my @sarg = (
lib/MToken.pm view on Meta::CPAN
}
# Get data from database
my %data = $store->get($filename);
unless ($store->status) {
$self->error($store->error || sprintf("Store (%s): Unknown error", $store->dsn));
return 0;
}
# Get file names
my $enc_file_path = path($self->tempdir, sprintf("%s.gpg", $filename));
my $dec_file_path = path($self->option("output") || File::Spec->catfile(getcwd(), $filename));
#say explain({enc_file_path => $enc_file_path->to_string, dec_file_path => $dec_file_path->to_string});
# Write file content on disk (spurt, spew; see also Module::Build::Base::_spew)
$enc_file_path->spurt($data{content} || "");
unless (filesize($enc_file_path->to_string)) {
$self->error(sprintf("Can't load empty file %s", $enc_file_path->to_string));
return 0;
}
# Decrypt file to tempdir
# gpg -d -q -o $bname $1
my $out_file = $dec_file_path->to_string;
my %exest = $self->execmd($self->get_gpgbin, "--decrypt", "--quiet", "--output", $out_file, $enc_file_path->to_string);
unless ($exest{status} && -e $out_file) {
$self->error(sprintf("Can't decrypt file %s", $enc_file_path->to_string));
my $newfile = $enc_file_path->copy_to(sprintf("%s.gpg", $out_file));
say magenta("The encrypted file has been stored to %s", $newfile->to_string) if filesize($newfile->to_string);
return 0;
}
# Check size
my $nsize = filesize($dec_file_path->to_string) || 0;
unless ($nsize == ($data{size} || 0)) {
$self->error(sprintf("File size mismatch (%s). Expected %d, got %d", $out_file, $nsize, $data{size} || 0));
return 0;
}
lib/MToken.pm view on Meta::CPAN
return 0;
}
# Show raw file
if ($self->option("raw")) {
say $data{content} || "";
return 1;
}
# Get file names
my $enc_file_path = path($self->tempdir, sprintf("%s.gpg", $filename));
my $dec_file_path = path($self->tempdir, $filename);
# Write file content on disk (spurt, spew; see also Module::Build::Base::_spew)
my $in_file = $enc_file_path->to_string;
$enc_file_path->spurt($data{content} || "");
unless (filesize($enc_file_path->to_string)) {
$self->error(sprintf("Can't load empty file %s", $in_file));
return 0;
}
# Decrypt file to tempdir
# gpg -d -q -o $bname $1
my $out_file = $dec_file_path->to_string;
my %exest = $self->execmd($self->get_gpgbin, "--decrypt", "--quiet", "--output", $out_file, $in_file);
unless ($exest{status} && -e $out_file) {
$self->error(sprintf("Can't decrypt file %s", $in_file));
say $data{content} || "";
return 0;
}
# Check size
my $nsize = filesize($dec_file_path->to_string) || 0;
unless ($nsize && $nsize == ($data{size} || 0)) {
$self->error(sprintf("File size mismatch (%s). Expected %d, got %d", $out_file, $nsize, $data{size} || 0));
lib/MToken.pm view on Meta::CPAN
chdir $newdir;
my $tar = Archive::Tar->new;
$tar->add_files(keys(%$manifest));
for my $f ($tar->get_files) {
$f->mode($f->mode & ~022); # chmod go-w
}
$tar->write($tarball_arch_path->to_string, 1);
chdir $curdir;
# Encrypt file to tempdir
my %exest = $self->execmd($self->get_gpgbin, "--encrypt", "--quiet", "--recipient", $fingerprint, "--output",
$tarball_path->to_string, $tarball_arch_path->to_string);
unless ($exest{status} && -f $tarball_path->to_string) {
$self->error(sprintf("Can't encrypt file %s: %s", $tarball_arch_path->to_string, $exest{error}));
return 0;
}
$tarball_arch_path->remove;
# Upload (PUT method)
my $status = $self->client->upload($self->get_name, $tarball_path->to_string); # "C20211009T090718.tkn"
#say magenta($tarball_path->to_string);
lib/MToken.pm view on Meta::CPAN
say yellow("The current token was changed later than the one in the repository.");
unless ($self->option("force") ||
$self->cli_prompt('Are you sure you want to revert to an earlier state of the token?:','no') =~ /^\s*y/i) {
return skip("Aborted");
}
}
}
# Decrypt file
unless (-e $archive_path->to_string) {
my %exest = $self->execmd($self->get_gpgbin, "--decrypt", "--quiet", "--output", $archive_path->to_string, $tarball_path->to_string);
unless ($exest{status} && -e $archive_path->to_string) {
$self->error(sprintf("Can't decrypt file %s: %s", $tarball_path->to_string, $exest{error}));
return 0;
}
$tarball_path->remove;
}
# Store to selected file or directory
if ($self->option("output") || $self->option("outdir")) {
my $file_out = $self->option("output");
lib/MToken.pm view on Meta::CPAN
);
}
sub get_name {
my $self = shift;
$self->lconfig->{name};
}
sub get_opensslbin {
my $self = shift;
return $self->lconfig->get("opensslbin") || $self->conf("opensslbin") || which(OPENSSLBIN) || OPENSSLBIN;
}
sub get_gpgbin {
my $self = shift;
return $self->lconfig->get("gpgbin") || $self->conf("gpgbin") || which(GPGBIN) || GPGBIN;
}
sub get_server_url {
my $self = shift;
return $self->lconfig->get("server_url") || $self->conf("server_url") || SERVER_URL;
}
sub get_fingerprint {
my $self = shift;
my $fingerprint_cfg = $self->lconfig->get("fingerprint") || $self->conf("fingerprint") || "";
my $fingerprint = "";
my %exest = ();
# Get public keys info
unless ($self->option("force")) {
%exest = $self->execmd($self->get_gpgbin, "--list-keys");
if ($exest{status}) {
say blue($exest{output} || "no keys found");
}
}
# Get public keys fingerprints
%exest = $self->execmd($self->get_gpgbin, "--list-keys", "--with-colons");
if ($exest{status} && $exest{output}) {
my @fingerprints = map {$_ = uc($1) if /\:([0-9a-f]{16,40})\:/i } grep { /fpr/ } split("\n", $exest{output});
my $fingerprint_default = $fingerprint_cfg || $fingerprints[0] || 'none';
while (1) {
if ($self->option("force")) {
$fingerprint = $fingerprint_default;
$fingerprint = "" if $fingerprint =~ /^\s*n/i;
last;
}
$fingerprint = uc($self->cli_prompt('Please provide the fingerprint of recipient:', $fingerprint_default));
lib/MToken/Config.pm view on Meta::CPAN
use CTK::Util qw/preparedir/;
use MToken::Const qw/ :GENERAL :MATH /;
use vars qw/$VERSION/;
$VERSION = '1.03';
use constant {
ALLOWED_KEYS => [qw/
token
server_url
gpgbin opensslbin
fingerprint
/],
};
sub new {
my $class = shift;
my %args = (@_);
my $is_loaded = 0;
my $config_file = $args{file} || $args{config_file} || $args{device_file}
lib/MToken/Const.pm view on Meta::CPAN
GLOBAL_CONF_FILE => 'mtoken.conf',
DEVICE_CONF_FILE => 'mtoken.conf',
DEVICE_MANIFEST_FILE=> 'manifest.lst',
DB_FILE => 'tokencase.db',
RND_KEY_FILE => 'tokenrnd.key',
PWCACHE_FILE => 'pwcache.tmp',
PUBLIC_GPG_KEY => 'public.key',
PRIVATE_GPG_KEY => 'private.key',
MY_PUBLIC_KEY => 'mypublic.key',
MY_PRIVATE_KEY => 'myprivate.key',
GPGCONFFILE => 'gpg.conf',
# System paths
GPGBIN => 'gpg',
OPENSSLBIN => 'openssl',
# Server
SERVER_URL => 'https://localhost:8642/mtoken',
SERVER_LISTEN_PORT => 8642,
SERVER_LISTEN_ADDR => "*",
UPGRADE_TIMEOUT => 30,
# MATH
TRUE => 1,
( run in 0.975 second using v1.01-cache-2.11-cpan-df04353d9ac )