PageRenderTime 46ms CodeModel.GetById 24ms RepoModel.GetById 1ms app.codeStats 0ms

/lib/Passwd/Keyring/Gnome.pm

https://bitbucket.org/Mekk/perl-keyring-gnome
Perl | 185 lines | 114 code | 67 blank | 4 comment | 14 complexity | fee3a0e7108843a11108348af1d75151 MD5 | raw file
  1. package Passwd::Keyring::Gnome;
  2. use warnings;
  3. use strict;
  4. #use parent 'Keyring';
  5. use Carp qw(croak);
  6. require DynaLoader;
  7. use base 'DynaLoader';
  8. =head1 NAME
  9. Passwd::Keyring::Gnome - Password storage implementation based on GNOME Keyring.
  10. =head1 VERSION
  11. Version 0.3003
  12. =cut
  13. our $VERSION = '0.3003';
  14. bootstrap Passwd::Keyring::Gnome $VERSION;
  15. =head1 SYNOPSIS
  16. Gnome Keyring based implementation of L<Keyring>. Provide secure
  17. storage for passwords and similar sensitive data.
  18. use Passwd::Keyring::Gnome;
  19. my $keyring = Passwd::Keyring::Gnome->new(
  20. app=>"blahblah scraper",
  21. group=>"Johnny web scrapers",
  22. );
  23. my $username = "John"; # or get from .ini, or from .argv...
  24. my $password = $keyring->get_password($username, "blahblah.com");
  25. unless( $password ) {
  26. $password = <somehow interactively prompt for password>;
  27. # securely save password for future use
  28. $keyring->set_password($username, $password, "blahblah.com");
  29. }
  30. login_somewhere_using($username, $password);
  31. if( password_was_wrong ) {
  32. $keyring->clear_password($username, "blahblah.com");
  33. }
  34. Note: see L<Passwd::Keyring::Auto::KeyringAPI> for detailed comments
  35. on keyring method semantics (this document is installed with
  36. C<Passwd::Keyring::Auto> package).
  37. =head1 SUBROUTINES/METHODS
  38. =head2 new(app=>'app name', group=>'passwords folder')
  39. Initializes the processing. Croaks if gnome keyring does not
  40. seem to be available.
  41. Handled named parameters:
  42. - app - symbolic application name (not used at the moment, but can be
  43. used in future as comment and in prompts, so set sensibly)
  44. - group - name for the password group (will be visible in seahorse so
  45. can be used by end user to manage passwords, different group means
  46. different password set, a few apps may share the same group if they
  47. need to use the same passwords set)
  48. =cut
  49. sub new {
  50. my ($cls, %opts) = @_;
  51. my $self = {
  52. app => $opts{app} || 'Passwd::Keyring',
  53. group => $opts{group} || 'Passwd::Keyring unclassified passwords',
  54. };
  55. bless $self;
  56. # TODO: catch and rethrow exceptions
  57. my $name = Passwd::Keyring::Gnome::_get_default_keyring_name();
  58. croak ("Gnome Keyring seems unavailable (failed to read default keyring name)") unless $name;
  59. return $self;
  60. }
  61. =head2 set_password(username, password, realm)
  62. Sets (stores) password identified by given realm for given user
  63. =cut
  64. sub set_password {
  65. my ($self, $user_name, $user_password, $realm) = @_;
  66. Passwd::Keyring::Gnome::_set_password(
  67. $user_name, $user_password,
  68. $realm, $self->{group},
  69. "$self->{group}/$realm/$user_name (by $self->{app})");
  70. }
  71. =head2 get_password($user_name, $realm)
  72. Reads previously stored password for given user in given app.
  73. If such password can not be found, returns undef.
  74. =cut
  75. sub get_password {
  76. my ($self, $user_name, $realm) = @_;
  77. my $pwd = Passwd::Keyring::Gnome::_get_password(
  78. $user_name, $realm, $self->{group});
  79. #return undef if (!defined($pwd)) or $pwd eq "";
  80. return $pwd;
  81. }
  82. =head2 clear_password($user_name, $realm)
  83. Removes given password (if present)
  84. Returns how many passwords actually were removed
  85. =cut
  86. sub clear_password {
  87. my ($self, $user_name, $realm) = @_;
  88. return Passwd::Keyring::Gnome::_clear_password(
  89. $user_name, $realm, $self->{group});
  90. }
  91. =head2 is_persistent
  92. Returns info, whether this keyring actually saves passwords persistently.
  93. (true in this case)
  94. =cut
  95. sub is_persistent {
  96. my ($self) = @_;
  97. return 1;
  98. }
  99. =head1 AUTHOR
  100. Marcin Kasperski
  101. =head1 BUGS
  102. Please report any bugs or feature requests to
  103. issue tracker at L<https://bitbucket.org/Mekk/perl-keyring-gnome>.
  104. =head1 SUPPORT
  105. You can find documentation for this module with the perldoc command.
  106. perldoc Passwd::Keyring::Gnome
  107. You can also look for information at:
  108. L<http://search.cpan.org/~mekk/Passwd-Keyring-Gnome/>
  109. Source code is tracked at:
  110. L<https://bitbucket.org/Mekk/perl-keyring-gnome>
  111. =head1 LICENSE AND COPYRIGHT
  112. Copyright 2012 Marcin Kasperski.
  113. This program is free software; you can redistribute it and/or modify it
  114. under the terms of either: the GNU General Public License as published
  115. by the Free Software Foundation; or the Artistic License.
  116. See http://dev.perl.org/licenses/ for more information.
  117. =cut
  118. 1; # End of Passwd::Keyring::Gnome