Marcin Kasperski avatar Marcin Kasperski committed 179cc79

First steps toward implementation.

Comments (0)

Files changed (14)

 \.bak$
 ^META\.
 ^Makefile\.PL
-^Passwd-Keyring-Gnome-v.*\.tar\.gz$
+^Passwd-Keyring-KDEWallet-v.*\.tar\.gz$
 use Module::Build;
 use ExtUtils::PkgConfig;
 
-my %gnome_keyring_pkg_info = ExtUtils::PkgConfig->find("gnome-keyring-1");
-
 my $builder = Module::Build->new(
-    module_name         => 'Passwd::Keyring::Gnome',
+    module_name         => 'Passwd::Keyring::KDEWallet',
     dynamic_config      => 1,
     license             => 'perl',
     dist_author         => q{Marcin Kasperski <Marcin.Kasperski@mekk.waw.pl>},
-    dist_version_from   => 'lib/Passwd/Keyring/Gnome.pm',
+    dist_version_from   => 'lib/Passwd/Keyring/KDEWallet.pm',
     build_requires => {
         'Module::Build' => '0.19', # xs
         'ExtUtils::CBuilder' => 0,
     },
     requires => {
         'perl' => 5.006,
+        'Net::DBus' => 0,
     },
-    add_to_cleanup      => [ 'Passwd-Keyring-Gnome-*' ],
+    add_to_cleanup      => [ 'Passwd-Keyring-KDEWallet-*' ],
     create_makefile_pl => 'traditional',
-    # pkg-config --cflags gnome-keyring-1
-    #extra_compiler_flags => '-I/usr/include/gnome-keyring-1 -I/usr/include/glib-2.0 -I/usr/lib/x86_64-linux-gnu/glib-2.0/include',
-    extra_compiler_flags => $gnome_keyring_pkg_info{cflags},
-    # pkg-config --libs gnome-keyring-1
-    #extra_linker_flags => '-lgnome-keyring -lglib-2.0',
-    extra_linker_flags => $gnome_keyring_pkg_info{libs},
-    needs_compiler => 1,
-    #c_source => 'src',
-    #xs_files => {
-        #'./Costam.xs' => 'lib/MyMod/Costam.xs',
-    #},
 );
 
 $builder->create_build_script();
 Build.PL
 Changes
-lib/Passwd/Keyring/Gnome.pm
-lib/Passwd/Keyring/Gnome.xs
+lib/Passwd/Keyring/KDEWallet.pm
 MANIFEST			This list of files
 README
 t/00-load.t
 ^MANIFEST\.SKIP
 
 # Avoid archives of this distribution
-\bPasswd-Keyring-Gnome-[\d\.\_]+
+\bPasswd-Keyring-KDEWallet-[\d\.\_]+
 
 # Repo-related
 ^\.hg
 ^version_hook\.py
 ^ignore\.txt
 
-# Produced
-^lib/Passwd/Keyring/Gnome\.[co]$
-Passwd::Keyring::Gnome
+Passwd::Keyring::KDEWallet
 
 Passwd::Keyring is about using secure storage for passwords
 and other credentials used in perl scripts and applications.
 
-Passwd::Keyring::Gnome uses GNOME Keyring API to securely
-preserve passwords and is available to people using GNOME 
-desktop environment.
+Passwd::Keyring::KDEWallet uses KDE KWallet API to securely
+preserve passwords and is available to people using KDE
+desktop environment (or at least with installed kwallet).
 
 INSTALLATION
 
 After installing, you can find documentation for this module with the
 perldoc command.
 
-    perldoc Keyring::Gnome
+    perldoc Passwd::Keyring::KDEWallet
 
 You can also look for information at:
 
-    http://bitbucket.org/Mekk/perl-keyring
+    http://bitbucket.org/Mekk/perl-keyring-kde_wallet
 
 
 LICENSE AND COPYRIGHT

lib/Passwd/Keyring/Gnome.pm

-package Passwd::Keyring::Gnome;
-
-use warnings;
-use strict;
-#use parent 'Keyring';
-
-require DynaLoader;
-require AutoLoader;
-
-use base 'DynaLoader';
-
-=head1 NAME
-
-Passwd::Keyring::Gnome - Password storage implementation based on GNOME Keyring.
-
-=head1 VERSION
-
-Version 0.21
-
-=cut
-
-our $VERSION = '0.21';
-
-bootstrap Passwd::Keyring::Gnome $VERSION;
-
-=head1 SYNOPSIS
-
-Gnome Keyring based implementation of L<Keyring>.
-
-    use Passwd::Keyring::Gnome;
-
-    my $keyring = Passwd::Keyring::Gnome->new();
-
-    $keyring->set_password("John", "verysecret", "my-pseudodomain");
-    # And later, on next run maybe
-    my $password = $keyring->get_password("John", "my-pseudodomain");
-    # plus
-    $keyring->clear_password("John", "my-pseudodomain");
-
-=head1 SUBROUTINES/METHODS
-
-=head2 new
-
-Initializes the processing. Croaks if gnome keyring does not 
-seem to be available.
-
-=cut
-
-sub new {
-    my $self = {};
-    bless $self;
-
-    # TODO: catch and rethrow exceptions
-    my $name = Passwd::Keyring::Gnome::_get_default_keyring_name();
-    croak ("Gnome Keyring seems unavailable") unless $name;
-
-    return $self;
-}
-
-=head2 set_password(username, password, domain)
-
-Sets (stores) password identified by given domain for given user 
-
-=cut
-
-sub set_password {
-    my ($self, $user_name, $user_password, $domain) = @_;
-    Passwd::Keyring::Gnome::_set_password($user_name, $user_password, $domain);
-}
-
-=head2 get_password($user_name, $domain)
-
-Reads previously stored password for given user in given app.
-If such password can not be found, returns undef.
-
-=cut
-
-sub get_password {
-    my ($self, $user_name, $domain) = @_;
-    my $pwd = Passwd::Keyring::Gnome::_get_password($user_name, $domain);
-    return undef if (!defined($pwd)) or $pwd eq "";
-    return $pwd;
-}
-
-=head2 clear_password($user_name, $domain)
-
-Removes given password (if present)
-
-=cut
-
-sub clear_password {
-    my ($self, $user_name, $domain) = @_;
-    Passwd::Keyring::Gnome::_set_password($user_name, "", $domain);
-}
-
-=head1 AUTHOR
-
-Marcin Kasperski, C<< <Marcin.Kasperski at mekk.waw.pl> >>
-
-=head1 BUGS
-
-Please report any bugs or feature requests to 
-issue tracker at L<https://bitbucket.org/Mekk/perl-keyring-gnome>.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command.
-
-    perldoc Passwd::Keyring::Gnome
-
-You can also look for information at:
-
-    L<https://bitbucket.org/Mekk/perl-keyring-gnome>
-
-=head1 LICENSE AND COPYRIGHT
-
-Copyright 2010-2012 Marcin Kasperski.
-
-This program is free software; you can redistribute it and/or modify it
-under the terms of either: the GNU General Public License as published
-by the Free Software Foundation; or the Artistic License.
-
-See http://dev.perl.org/licenses/ for more information.
-
-=cut
-
-
-1; # End of Passwd::Keyring::Gnome
-
-

lib/Passwd/Keyring/Gnome.xs

-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#include "glib.h"
-#include "gnome-keyring.h"
-
-const char* SERVER = "using_gnome_keyring";
-
-MODULE=Passwd::Keyring::Gnome    PACKAGE=Passwd::Keyring::Gnome 
-
-SV*
-_get_default_keyring_name()
-    CODE:
-        char *name;
-        gnome_keyring_get_default_keyring_sync(&name);
-        RETVAL = newSVpv(name, 0);
-        g_free(name);
-    OUTPUT:
-        RETVAL
-
-void
-_set_password(const char *user, const char* password, const char *domain)
-    CODE:
-        guint32 item_id;
-        if(GNOME_KEYRING_RESULT_OK == 
-           gnome_keyring_set_network_password_sync(
-              NULL, /* keyring (null=default) */
-              user,
-              domain,
-              SERVER, /* server */
-              NULL, /* remote object */
-              NULL, /* protocol */
-              NULL, /* auth-type */
-              0,    /* port */
-              password,    
-              &item_id))
-        {
-              /* printf("Saved password, id: %d\n", item_id); */
-              return;
-        }
-        else
-        {
-                croak("Failed to set password");
-        }
-
-
-SV*
-_get_password(const char *user, const char *domain)
-    CODE:
-        GList *results;
-        GnomeKeyringResult status = 
-             gnome_keyring_find_network_password_sync(
-                user,
-                domain,
-                SERVER, /* server */
-                NULL, /* remote object */
-                NULL, /* protocol */
-                NULL, /* auth-type */
-                0,    /* port */
-                &results);
-        if(status == GNOME_KEYRING_RESULT_OK)
-        {
-            GList *node;
-            GnomeKeyringNetworkPasswordData *item;
-            RETVAL = 0;
-            for (node = g_list_first (results);
-                 node != NULL;
-                 node = g_list_next (node))
-            {
-              item = (GnomeKeyringNetworkPasswordData *) node->data;
-              RETVAL = newSVpv(item->password, 0);
-              /*
-              printf("Found item.\n");
-              printf("  item-id: %d\n", item->item_id);
-              printf("  keyring: %s\n", item->keyring);
-              printf("  server: %s\n", item->server);
-              printf("  object: %s\n", item->object);
-              printf("  port: %d\n", item->port);
-              printf("  user: %s\n", item->user);
-              printf("  domain: %s\n", item->domain);
-              printf("  password: %s\n", item->password); */
-              break;
-            }
-
-            if(! RETVAL)
-            {
-               RETVAL = newSV(0);
-            }
-
-            gnome_keyring_network_password_list_free(results);
-        }
-        else if (status == GNOME_KEYRING_RESULT_NO_MATCH)
-        {
-            RETVAL = newSV(0);
-        }
-        else
-        {
-            croak("Failed to find a password. Error code: %d", status);
-        }
-    OUTPUT:
-        RETVAL
-

lib/Passwd/Keyring/KDEWallet.pm

+package Passwd::Keyring::KDEWallet;
+
+use warnings;
+use strict;
+#use parent 'Keyring';
+use Net::DBus;
+
+=head1 NAME
+
+Passwd::Keyring::KDEWallet - Password storage implementation based on KDE Wallet.
+
+=head1 VERSION
+
+Version 0.21
+
+=cut
+
+our $VERSION = '0.21';
+
+=head1 SYNOPSIS
+
+KDE Wallet based implementation of L<Passwd::Keyring>.
+
+    use Passwd::Keyring::KDEWallet;
+
+    my $keyring = Passwd::Keyring::KDEWallet->new();
+
+    $keyring->set_password("John", "verysecret", "my-pseudodomain");
+    # And later, on next run maybe
+    my $password = $keyring->get_password("John", "my-pseudodomain");
+    # plus
+    $keyring->clear_password("John", "my-pseudodomain");
+
+=head1 SUBROUTINES/METHODS
+
+=head2 new
+
+Initializes the processing. Croaks if kwallet does not 
+seem to be available.
+
+=cut
+
+sub new {
+    my $self = {};
+    bless $self;
+
+    # TODO: maybe some of those objects should rather be
+    # created on demand and thrown away immediately.
+
+    #$self->{bus} = Net::DBus->find()
+    $self->{bus} = Net::DBus->session()
+      or croak("KWallet not available (can't access DBus)");
+    $self->{kwallet_svc} = $self->{bus}->get_service('org.kde.kwalletd')
+      or croak("KWallet not available (can't access KWallet, likely kwalletd not running)");
+    my $kwallet = $self->{kwallet_svc}->get_object('/modules/kwalletd', 'org.kde.KWallet')
+      or croak("Kwallet not available (can't find wallet)");
+    $self->{kwallet} = $kwallet->networkWallet();
+
+    print "Network Wallet = $networkWallet\n";
+
+    # TODO: later
+    my $kwallet_handle = $KWallet->open($self->{kwallet}, 0, $app_name);
+    print "Opened = $kwallet_handle\n";
+
+    my $folders = $KWallet->folderList($kwallet_handle,$app_name);
+    print "Folders = ", dump($folders);
+
+    return $self;
+}
+
+=head2 set_password(username, password, domain)
+
+Sets (stores) password identified by given domain for given user 
+
+=cut
+
+sub set_password {
+    my ($self, $user_name, $user_password, $domain) = @_;
+}
+
+=head2 get_password($user_name, $domain)
+
+Reads previously stored password for given user in given app.
+If such password can not be found, returns undef.
+
+=cut
+
+sub get_password {
+    my ($self, $user_name, $domain) = @_;
+    my $u = $KWallet->readPassword($kwallet_handle, 'MyFolder','Some_Userid_Key', $app_name);
+    say "Password = ", dump($p);
+}
+
+=head2 clear_password($user_name, $domain)
+
+Removes given password (if present)
+
+=cut
+
+sub clear_password {
+    my ($self, $user_name, $domain) = @_;
+}
+
+=head1 AUTHOR
+
+Marcin Kasperski, C<< <Marcin.Kasperski at mekk.waw.pl> >>
+
+Code heavily inspired by L<http://www.perlmonks.org/?node_id=869620>
+and partially by python keyring.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to 
+issue tracker at L<https://bitbucket.org/Mekk/perl-keyring-kdewallet>.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc Passwd::Keyring::KDEWallet
+
+You can also look for information at:
+
+    L<https://bitbucket.org/Mekk/perl-keyring-kdewallet>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2010-2012 Marcin Kasperski.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+=cut
+
+
+1; # End of Passwd::Keyring::KDEWallet
+
+
 use Test::More tests => 1;
 
 BEGIN {
-    use_ok( 'Passwd::Keyring::Gnome' ) || print "Bail out!\n";
+    use_ok( 'Passwd::Keyring::KDEWallet' ) || print "Bail out!\n";
 }
 
-diag( "Testing Passwd::Keyring::Gnome $Passwd::Keyring::Gnome::VERSION, Perl $], $^X" );
+diag( "Testing Passwd::Keyring::KDEWallet $Passwd::Keyring::KDEWallet::VERSION, Perl $], $^X" );

t/01-set-and-get.t

 use warnings;
 use Test::Simple tests => 3;
 
-use Passwd::Keyring::Gnome;
+use Passwd::Keyring::KDEWallet;
 
-my $ring = Passwd::Keyring::Gnome->new;
+my $ring = Passwd::Keyring::KDEWallet->new;
 
-ok( defined($ring) && ref $ring eq 'Passwd::Keyring::Gnome',   'new() works' );
+ok( defined($ring) && ref $ring eq 'Passwd::Keyring::KDEWallet',   'new() works' );
 
 $ring->set_password("John", "secret", 'my@@domain');
 #$ring->set_password("John", "secret", 'my@@domain');

t/02-many-sets-and-gets.t

 use warnings;
 use Test::Simple tests => 11;
 
-use Passwd::Keyring::Gnome;
+use Passwd::Keyring::KDEWallet;
 
-my $ring = Passwd::Keyring::Gnome->new;
+my $ring = Passwd::Keyring::KDEWallet->new;
 
-ok( defined($ring) && ref $ring eq 'Passwd::Keyring::Gnome',   'new() works' );
+ok( defined($ring) && ref $ring eq 'Passwd::Keyring::KDEWallet',   'new() works' );
 
 $ring->set_password("Paul", "secret-Paul", 'my@@domain');
 $ring->set_password("Gregory", "secret-Greg", 'my@@domain');#

t/03-recovering-in-sep-prog.t

 use warnings;
 use Test::Simple tests => 5;
 
-use Passwd::Keyring::Gnome;
+use Passwd::Keyring::KDEWallet;
 
-my $ring = Passwd::Keyring::Gnome->new;
+my $ring = Passwd::Keyring::KDEWallet->new;
 
-ok( defined($ring) && ref $ring eq 'Passwd::Keyring::Gnome',   'new() works' );
+ok( defined($ring) && ref $ring eq 'Passwd::Keyring::KDEWallet',   'new() works' );
 
 ok( ! defined($ring->get_password("Paul", 'my@@domain')), "get works");
 
 use warnings;
 use Test::Simple tests => 8;
 
-use Passwd::Keyring::Gnome;
+use Passwd::Keyring::KDEWallet;
 
-my $ring = Passwd::Keyring::Gnome->new;
+my $ring = Passwd::Keyring::KDEWallet->new;
 
-ok( defined($ring) && ref $ring eq 'Passwd::Keyring::Gnome',   'new() works' );
+ok( defined($ring) && ref $ring eq 'Passwd::Keyring::KDEWallet',   'new() works' );
 
 $ring->clear_password("Paul", 'my@@domain');
 ok(1, "clear_password works");
     "placeholder date/time"       => qr(Date/time)
   );
 
-  module_boilerplate_ok('lib/Passwd/Keyring/Gnome.pm');
+  module_boilerplate_ok('lib/Passwd/Keyring/KDEWallet.pm');
 
 
 }
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.