diff options
| author | Bill MacAllister <whm@dropbox.com> | 2015-12-18 21:54:52 +0000 | 
|---|---|---|
| committer | Bill MacAllister <whm@dropbox.com> | 2015-12-18 21:54:52 +0000 | 
| commit | f61bff40b0c76b01b89f8b977eb27fdef9409c2a (patch) | |
| tree | 9812f0b1c38e001d6ddd8d7343adc40fa800e338 /perl/lib | |
| parent | 0eb853eb2ef7e7063c0219ce2cbd1e239d5579b7 (diff) | |
| parent | 4a777845b06b62a6deb1df5e69cc9b21226c3c2f (diff) | |
Merge branch 'master' into ad-keytabs
Conflicts:
	NEWS
Diffstat (limited to 'perl/lib')
| -rw-r--r-- | perl/lib/Wallet/ACL.pm | 96 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/Base.pm | 13 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm | 128 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/Nested.pm | 189 | ||||
| -rw-r--r-- | perl/lib/Wallet/Admin.pm | 21 | ||||
| -rw-r--r-- | perl/lib/Wallet/Config.pm | 71 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Base.pm | 9 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Duo.pm | 121 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Duo/LDAPProxy.pm | 202 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Duo/PAM.pm | 205 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Duo/RDP.pm | 204 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Duo/RadiusProxy.pm | 204 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Keytab.pm | 59 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Password.pm | 228 | ||||
| -rw-r--r-- | perl/lib/Wallet/Policy/Stanford.pm | 144 | ||||
| -rw-r--r-- | perl/lib/Wallet/Report.pm | 232 | ||||
| -rw-r--r-- | perl/lib/Wallet/Schema.pm | 4 | ||||
| -rw-r--r-- | perl/lib/Wallet/Schema/Result/AclScheme.pm | 4 | ||||
| -rw-r--r-- | perl/lib/Wallet/Server.pm | 57 | 
19 files changed, 1293 insertions, 898 deletions
| diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index a3b0146..862b88f 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -1,7 +1,7 @@  # Wallet::ACL -- Implementation of ACLs in the wallet system.  #  # Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2007, 2008, 2010, 2013, 2014 +# Copyright 2007, 2008, 2010, 2013, 2014, 2015  #     The Board of Trustees of the Leland Stanford Junior University  #  # See LICENSE for licensing terms. @@ -17,13 +17,14 @@ use strict;  use warnings;  use vars qw($VERSION); +use Wallet::Object::Base;  use DateTime;  use DBI;  # This version should be increased on any code change to this module.  Always  # use two digits for the minor version with a leading zero if necessary so  # that it will sort properly. -$VERSION = '0.08'; +$VERSION = '0.09';  ##############################################################################  # Constructors @@ -197,16 +198,55 @@ sub rename {          $acls->ac_name ($name);          $acls->update;          $self->log_acl ('rename', undef, undef, $user, $host, $time); + +        # Find any references to this being used as a nested verifier and +        # update the name.  This really breaks out of the normal flow, but +        # it's hard to do otherwise. +        %search = (ae_scheme     => 'nested', +                   ae_identifier => $self->{name}, +                  ); +        my @entries = $self->{schema}->resultset('AclEntry')->search(\%search); +        for my $entry (@entries) { +            $entry->ae_identifier ($name); +            $entry->update; +        } +          $guard->commit;      };      if ($@) { -        $self->error ("cannot rename ACL $self->{id} to $name: $@"); +        $self->error ("cannot rename ACL $self->{name} to $name: $@");          return;      }      $self->{name} = $name;      return 1;  } +# Moves everything owned by one ACL to instead be owned by another.  You'll +# normally want to use rename, but this exists for cases where the replacing +# ACL already exists and has things assigned to it.  Returns true on success, +# false on failure. +sub replace { +    my ($self, $replace_id, $user, $host, $time) = @_; +    $time ||= time; + +    my %search = (ob_owner => $self->{id}); +    my @objects = $self->{schema}->resultset('Object')->search (\%search); +    if (@objects) { +        for my $object (@objects) { +            my $type   = $object->ob_type; +            my $name   = $object->ob_name; +            my $object = eval { +                Wallet::Object::Base->new($type, $name, $self->{schema}); +            }; +            $object->owner ($replace_id, $user, $host, $time); +        } +    } else { +        $self->error ("no objects found for ACL $self->{name}"); +        return; +    } +    return 1; +} +  # Destroy the ACL, deleting it out of the database.  Returns true on success,  # false on failure.  # @@ -233,8 +273,20 @@ sub destroy {              die "ACL in use by ".$entry->ob_type.":".$entry->ob_name;          } +        # Also make certain the ACL isn't being nested in another. +        my %search = (ae_scheme     => 'nested', +                      ae_identifier => $self->{name}); +        my %options = (join     => 'acls', +                       prefetch => 'acls'); +        @entries = $self->{schema}->resultset('AclEntry')->search(\%search, +                                                                  \%options); +        if (@entries) { +            my ($entry) = @entries; +            die "ACL is nested in ACL ".$entry->acls->ac_name; +        } +          # Delete any entries (there may or may not be any). -        my %search = (ae_id => $self->{id}); +        %search = (ae_id => $self->{id});          @entries = $self->{schema}->resultset('AclEntry')->search(\%search);          for my $entry (@entries) {              $entry->delete; @@ -257,7 +309,7 @@ sub destroy {          $guard->commit;      };      if ($@) { -        $self->error ("cannot destroy ACL $self->{id}: $@"); +        $self->error ("cannot destroy ACL $self->{name}: $@");          return;      }      return 1; @@ -275,6 +327,22 @@ sub add {          $self->error ("unknown ACL scheme $scheme");          return;      } + +    # Check to make sure that this entry has a valid name for the scheme. +    my $class = $self->scheme_mapping ($scheme); +    my $object = eval { +        $class->new ($identifier, $self->{schema}); +    }; +    if ($@) { +        $self->error ("cannot create ACL verifier: $@"); +        return; +    } +    unless ($object && $object->syntax_check ($identifier)) { +        $self->error ("invalid ACL identifier $identifier for $scheme"); +        return; +    }; + +    # Actually create the scheme.      eval {          my $guard = $self->{schema}->txn_scope_guard;          my %record = (ae_id         => $self->{id}, @@ -285,7 +353,7 @@ sub add {          $guard->commit;      };      if ($@) { -        $self->error ("cannot add $scheme:$identifier to $self->{id}: $@"); +        $self->error ("cannot add $scheme:$identifier to $self->{name}: $@");          return;      }      return 1; @@ -312,7 +380,7 @@ sub remove {      };      if ($@) {          my $entry = "$scheme:$identifier"; -        $self->error ("cannot remove $entry from $self->{id}: $@"); +        $self->error ("cannot remove $entry from $self->{name}: $@");          return;      }      return 1; @@ -340,7 +408,7 @@ sub list {          $guard->commit;      };      if ($@) { -        $self->error ("cannot retrieve ACL $self->{id}: $@"); +        $self->error ("cannot retrieve ACL $self->{name}: $@");          return;      } else {          return @entries; @@ -395,7 +463,7 @@ sub history {          $guard->commit;      };      if ($@) { -        $self->error ("cannot read history for $self->{id}: $@"); +        $self->error ("cannot read history for $self->{name}: $@");          return;      }      return $output; @@ -419,7 +487,7 @@ sub history {                  push (@{ $self->{check_errors} }, "unknown scheme $scheme");                  return;              } -            $verifier{$scheme} = $class->new; +            $verifier{$scheme} = $class->new ($identifier, $self->{schema});              unless (defined $verifier{$scheme}) {                  push (@{ $self->{check_errors} }, "cannot verify $scheme");                  return; @@ -643,6 +711,14 @@ On failure, the caller should call error() to get the error message.  Note that rename() operations are not logged in the ACL history. +=item replace(ID) + +Replace this ACL with another.  This goes through each object owned by +the ACL and changes its ownership to the new ACL, leaving this ACL owning +nothing (and probably then needing to be deleted).  Returns true on +success and false on failure.  On failure, the caller should call error() +to get the error message. +  =item show()  Returns a human-readable description of this ACL, including its diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index a2b07cc..19ca612 100644 --- a/perl/lib/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -20,7 +20,7 @@ use vars qw($VERSION);  # This version should be increased on any code change to this module.  Always  # use two digits for the minor version with a leading zero if necessary so  # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03';  ##############################################################################  # Interface @@ -37,6 +37,11 @@ sub new {      return $self;  } +# The default name check method allows any name. +sub syntax_check { +    return 1; +} +  # The default check method denies all access.  sub check {      return 0; @@ -92,6 +97,12 @@ inherit from it.  It is not used directly.  Creates a new ACL verifier.  The generic function provided here just  creates and blesses an object. +=item syntax_check(PRINCIPAL, ACL) + +This method should be overridden by any child classes that want to +implement validating the name of an ACL before creation.  The default +implementation allows any name for an ACL. +  =item check(PRINCIPAL, ACL)  This method should always be overridden by child classes.  The default diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm new file mode 100644 index 0000000..eb30931 --- /dev/null +++ b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm @@ -0,0 +1,128 @@ +# Wallet::ACL::LDAP::Attribute::Root -- Wallet LDAP ACL verifier (root instances). +# +# Written by Jon Robertson <jonrober@stanford.edu> +# From Wallet::ACL::NetDB::Root by Russ Allbery <eagle@eyrie.org> +# Copyright 2015 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::LDAP::Attribute::Root; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +use Wallet::ACL::LDAP::Attribute; +use Wallet::Config; + +@ISA = qw(Wallet::ACL::LDAP::Attribute); + +# This version should be increased on any code change to this module.  Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# Interface +############################################################################## + +# Override the check method of Wallet::ACL::LDAP::Attribute to require that +# the principal be a root instance and to strip /root out of the principal +# name before checking roles. +sub check { +    my ($self, $principal, $acl) = @_; +    undef $self->{error}; +    unless ($principal) { +        $self->error ('no principal specified'); +        return; +    } +    unless ($principal =~ s%^([^/\@]+)/root(\@|\z)%$1$2%) { +        return 0; +    } +    return $self->SUPER::check ($principal, $acl); +} + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery LDAP verifier + +=head1 NAME + +Wallet::ACL::LDAP::Attribute::Root - Wallet ACL verifier for LDAP attributes (root instances) + +=head1 SYNOPSIS + +    my $verifier = Wallet::ACL::LDAP::Attribute::Root->new; +    my $status = $verifier->check ($principal, "$attr=$value"); +    if (not defined $status) { +        die "Something failed: ", $verifier->error, "\n"; +    } elsif ($status) { +        print "Access granted\n"; +    } else { +        print "Access denied\n"; +    } + +=head1 DESCRIPTION + +Wallet::ACL::LDAP::Attribute::Root works identically to +Wallet::ACL::LDAP::Attribute except that it requires the principal to +be a root instance (in other words, to be in the form +<principal>/root@<realm>) and strips the C</root> portion from the +principal before checking against the LDAP attribute and value.  As +with the base LDAP Attribute ACL verifier, the value of such a +C<ldap-attr-root> ACL is an attribute followed by an equal sign and a +value, and the ACL grants access to a given principal if and only if +the LDAP entry for that principal (with C</root> stripped) has that +attribute set to that value. + +To use this object, the same configuration parameters must be set as for +Wallet::ACL::LDAP::Attribute.  See Wallet::Config(3) for details on +those configuration parameters and information about how to set wallet +configuration. + +=head1 METHODS + +=over 4 + +=item check(PRINCIPAL, ACL) + +Returns true if PRINCIPAL is granted access according to ACL, false if +not, and undef on an error (see L<"DIAGNOSTICS"> below).  ACL must be an +attribute name and a value, separated by an equal sign (with no +whitespace).  PRINCIPAL will be granted access if it has an instance of +C<root> and if (with C</root> stripped off)  its LDAP entry contains +that attribute with that value + +=back + +=head1 DIAGNOSTICS + +Same as for Wallet::ACL::LDAP::Attribute. + +=head1 CAVEATS + +The instance to strip is not currently configurable. + +=head1 SEE ALSO + +Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), +Wallet::ACL::LDAP::Attribute(3), Wallet::Config(3), wallet-backend(8) + +This module is part of the wallet system.  The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHORS + +Jon Robertson <jonrober@stanford.edu> +Russ Allbery <eagle@eyrie.org> + +=cut diff --git a/perl/lib/Wallet/ACL/Nested.pm b/perl/lib/Wallet/ACL/Nested.pm new file mode 100644 index 0000000..07833f8 --- /dev/null +++ b/perl/lib/Wallet/ACL/Nested.pm @@ -0,0 +1,189 @@ +# Wallet::ACL::Nested - ACL class for nesting ACLs +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2015 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::Nested; +require 5.006; + +use strict; +use warnings; +use vars qw($VERSION @ISA); + +use Wallet::ACL::Base; + +@ISA = qw(Wallet::ACL::Base); + +# This version should be increased on any code change to this module.  Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# Interface +############################################################################## + +# Creates a new persistant verifier, taking a database handle to use for +# syntax check validation. +sub new { +    my $type = shift; +    my ($name, $schema) = @_; +    my $self = { +        schema   => $schema, +        expanded => {}, +    }; +    bless ($self, $type); +    return $self; +} + +# Name checking requires checking that there's an existing ACL already by +# this name.  Try to create the ACL object and use that to determine. +sub syntax_check { +    my ($self, $group) = @_; + +    my $acl; +    eval { $acl = Wallet::ACL->new ($group, $self->{schema}) }; +    return 0 if $@; +    return 0 unless $acl; +    return 1; +} + +# For checking a nested ACL, we need to expand each entry and then check +# that entry.  We also want to keep track of things already checked in order +# to avoid any loops. +sub check { +    my ($self, $principal, $group) = @_; +    unless ($principal) { +        $self->error ('no principal specified'); +        return; +    } +    unless ($group) { +        $self->error ('malformed nested ACL'); +        return; +    } + +    # Make an ACL object just so that we can use it to drop back into the +    # normal ACL validation after we have expanded the nesting. +    my $acl; +    eval { $acl = Wallet::ACL->new ($group, $self->{schema}) }; + +    # Get the list of all nested acl entries within this entry, and use it +    # to go through each entry and decide if the given acl has access. +    my @members = $self->get_membership ($group); +    for my $entry (@members) { +        my ($type, $name) = @{ $entry }; +        my $result = $acl->check_line ($principal, $type, $name); +        return 1 if $result; +    } +    return 0; +} + +# Get the membership of a group recursively.  The final result will be a list +# of arrayrefs like that from Wallet::ACL->list, but expanded for full +# membership. +sub get_membership { +    my ($self, $group) = @_; + +    # Get the list of members for this nested acl.  Consider any missing acls +    # as empty. +    my $schema = $self->{schema}; +    my @members; +    eval { +        my $acl  = Wallet::ACL->new ($group, $schema); +        @members = $acl->list; +    }; + +    # Now go through and expand any other nested groups into their own +    # memberships. +    my @expanded; +    for my $entry (@members) { +        my ($type, $name) = @{ $entry }; +        if ($type eq 'nested') { + +            # Keep track of things we've already expanded and don't look them +            # up again. +            next if exists $self->{expanded}{$name}; +            $self->{expanded}{$name} = 1; +            push (@expanded, $self->get_membership ($name)); + +        } else { +            push (@expanded, $entry); +        } +    } + +    return @expanded; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery verifier verifiers + +=head1 NAME + +Wallet::ACL::Nested - Wallet ACL verifier to check another ACL + +=head1 SYNOPSIS + +    my $verifier = Wallet::ACL::Nested->new; +    my $status = $verifier->check ($principal, $acl); +    if (not defined $status) { +        die "Something failed: ", $verifier->error, "\n"; +    } elsif ($status) { +        print "Access granted\n"; +    } else { +        print "Access denied\n"; +    } + +=head1 DESCRIPTION + +Wallet::ACL::Nested checks whether the principal is permitted by another +named ACL and, if so, returns success.  It is used to nest one ACL inside +another. + +=head1 METHODS + +=over 4 + +=item new() + +Creates a new ACL verifier. + +=item check(PRINCIPAL, ACL) + +Returns true if PRINCIPAL is granted access according to the nested ACL, +specified by name.  Returns false if it is not, and undef on error. + +=item error([ERROR ...]) + +Returns the error of the last failing operation or undef if no operations +have failed.  Callers should call this function to get the error message +after an undef return from any other instance method.  The returned errors +will generally come from the nested child ACL. + +=back + +=head1 SEE ALSO + +Wallet::ACL(3), wallet-backend(8) + +This module is part of the wallet system.  The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHOR + +Jon Robertson <jonrober@stanford.edu> + +=cut diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 8120e9c..b4246ba 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -115,22 +115,25 @@ sub default_data {      # acl_schemes default rows.      my ($r1) = $self->{schema}->resultset('AclScheme')->populate ([                         [ qw/as_name as_class/ ], -                       [ 'krb5',       'Wallet::ACL::Krb5'            ], -                       [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex'     ], -                       [ 'ldap-attr',  'Wallet::ACL::LDAP::Attribute' ], -                       [ 'netdb',      'Wallet::ACL::NetDB'           ], -                       [ 'netdb-root', 'Wallet::ACL::NetDB::Root'     ], +                       [ 'krb5',           'Wallet::ACL::Krb5'            ], +                       [ 'krb5-regex',     'Wallet::ACL::Krb5::Regex'     ], +                       [ 'ldap-attr',      'Wallet::ACL::LDAP::Attribute' ], +                       [ 'ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root' ], +                       [ 'nested',         'Wallet::ACL::Nested'          ], +                       [ 'netdb',          'Wallet::ACL::NetDB'           ], +                       [ 'netdb-root',     'Wallet::ACL::NetDB::Root'     ],                                                       ]);      warn "default AclScheme not installed" unless defined $r1;      # types default rows.      my @record = ([ qw/ty_name ty_class/ ],                 [ 'duo',        'Wallet::Object::Duo' ], -               [ 'duo-ldap',   'Wallet::Object::Duo::LDAPProxy' ], -               [ 'duo-pam',    'Wallet::Object::Duo::PAM' ], -               [ 'duo-radius', 'Wallet::Object::Duo::RadiusProxy' ], -               [ 'duo-rdp',    'Wallet::Object::Duo::RDP' ], +               [ 'duo-ldap',   'Wallet::Object::Duo' ], +               [ 'duo-pam',    'Wallet::Object::Duo' ], +               [ 'duo-radius', 'Wallet::Object::Duo' ], +               [ 'duo-rdp',    'Wallet::Object::Duo' ],                 [ 'file',       'Wallet::Object::File' ], +               [ 'password',   'Wallet::Object::Password' ],                 [ 'keytab',     'Wallet::Object::Keytab' ],                 [ 'wa-keyring', 'Wallet::Object::WAKeyring' ]);      ($r1) = $self->{schema}->resultset('Type')->populate (\@record); diff --git a/perl/lib/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index 2eb57f9..b3e1931 100644 --- a/perl/lib/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -260,6 +260,49 @@ our $FILE_MAX_SIZE;  =back +=head1 PASSWORD OBJECT CONFIGURATION + +These configuration variables only need to be set if you intend to use the +C<password> object type (the Wallet::Object::Password class).  You will also +need to set the FILE_MAX_SIZE value from the file object configuration, as +that is inherited. + +=over 4 + +=item PWD_FILE_BUCKET + +The directory into which to store password objects.  Password objects will +be stored in subdirectories of this directory.  See +L<Wallet::Object::Password> for the full details of the naming scheme.  This +directory must be writable by the wallet server and the wallet server must +be able to create subdirectories of it. + +PWD_FILE_BUCKET must be set to use file objects. + +=cut + +our $PWD_FILE_BUCKET; + +=item PWD_LENGTH_MIN + +The minimum length for any auto-generated password objects created when get +is run before data is stored. + +=cut + +our $PWD_LENGTH_MIN = 20; + +=item PWD_LENGTH_MAX + +The maximum length for any auto-generated password objects created when get +is run before data is stored. + +=cut + +our $PWD_LENGTH_MAX = 21; + +=back +  =head1 KEYTAB OBJECT CONFIGURATION  These configuration variables only need to be set if you intend to use the @@ -749,6 +792,34 @@ keytab objects for particular principals have fully-qualified hostnames:  Objects that aren't of type C<keytab> or which aren't for a host-based key  have no naming requirements enforced by this example. +=head1 OBJECT HOST-BASED NAMES + +The above demonstrates having a host-based naming convention, where we +expect one part of an object name to be the name of the host that this +object is for.  The most obvious examples are those keytab objects +above, where we want certain keytab names to be in the form of +<service>/<hostname>.  It's then also useful to provide a Perl function +named is_for_host which then can be used to tell if a given object is a +host-based keytab for a specific host.  This function is then called by +the objects_hostname in Wallet::Report to give a list of all host-based +objects for a given hostname.  It should return true if the given object +is a host-based object for the hostname, otherwise false. + +An example that matches the same policy as the last verify_name example +would be: + +    sub is_for_host { +        my ($type, $name, $hostname) = @_; +        my %host_based = map { $_ => 1 } +            qw(HTTP cifs host imap ldap nfs pop sieve smtp webauth); +        return 0 unless $type eq 'keytab'; +        return 0 unless $name =~ m%/%; +        my ($service, $instance) = split ('/', $name, 2); +        return 0 unless $host_based{$service}; +        return 1 if $hostname eq $instance; +        return 0; +    } +  =head1 ACL NAMING ENFORCEMENT  Similar to object names, by default wallet permits administrators to diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index bdd61fb..97e6127 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -609,6 +609,15 @@ sub history {  # The get methods must always be overridden by the subclass.  sub get { die "Do not instantiate Wallet::Object::Base directly\n"; } +# The update method should only work if a subclass supports it as something +# different from get.  That makes it explicit about whether the subclass has +# a meaningful update. +sub update { +    my ($self) = @_; +    $self->error ("update is not supported for this type, use get instead"); +    return; +} +  # Provide a default store implementation that returns an immutable object  # error so that auto-generated types don't have to provide their own.  sub store { diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index d08294b..d0901de 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -29,7 +29,100 @@ use Wallet::Object::Base;  # This version should be increased on any code change to this module.  Always  # use two digits for the minor version with a leading zero if necessary so  # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; + +# Mappings from our types into what Duo calls the integration types. +our %DUO_TYPES = ( +                  'duo'        => { +                      integration => 'unix', +                      output      => \&_output_generic, +                  }, +                  'duo-ldap'   => { +                      integration => 'ldapproxy', +                      output      => \&_output_ldap, +                  }, +                  'duo-pam'    => { +                      integration => 'unix', +                      output      => \&_output_pam, +                  }, +                  'duo-radius' => { +                      integration => 'radius', +                      output      => \&_output_radius, +                  }, +                 ); + +# Extra types to add.  These are all just named as the Duo integration name +# with duo- before it and go to the generic output.  Put them here to prevent +# pages of settings.  These are also not all actually set as types in the +# types table to prevent overpopulation.  You should manually create the +# entries in that table for any Duo integrations you want to add. +our @EXTRA_TYPES = ('accountsapi', 'adfs', 'adminapi', 'array', 'barracuda', +                    'cisco', 'citrixcag', 'citrixns', 'confluence', 'drupal', +                    'f5bigip', 'f5firepass', 'fortinet', 'jira', 'juniper', +                    'juniperuac', 'lastpass', 'okta', 'onelogin', 'openvpn', +                    'openvpnas', 'owa', 'paloalto', 'rdgateway', 'rdp', +                    'rdweb', 'rest', 'rras', 'shibboleth', 'sonicwallsra', +                    'splunk', 'tmg', 'uag', 'verify', 'vmwareview', 'websdk', +                    'wordpress'); +for my $type (@EXTRA_TYPES) { +    my $wallet_type = 'duo-'.$type; +    $DUO_TYPES{$wallet_type}{integration} = $type; +    $DUO_TYPES{$wallet_type}{output}      = \&_output_generic; +}; + +############################################################################## +# Get output methods +############################################################################## + +# Output for any miscellaneous Duo integration, usually those that use a GUI +# to set information and so don't need a custom configuration file. +sub _output_generic { +    my ($key, $secret, $hostname) = @_; + +    my $output; +    $output .= "Integration key: $key\n"; +    $output .= "Secret key:      $secret\n"; +    $output .= "Host:            $hostname\n"; + +    return $output; +} + +# Output for the Duo unix integration, which hooks into the PAM stack. +sub _output_pam { +    my ($key, $secret, $hostname) = @_; + +    my $output = "[duo]\n"; +    $output .= "ikey = $key\n"; +    $output .= "skey = $secret\n"; +    $output .= "host = $hostname\n"; + +    return $output; +} + +# Output for the radius proxy, which can be plugged into the proxy config. +sub _output_radius { +    my ($key, $secret, $hostname) = @_; + +    my $output = "[radius_server_challenge]\n"; +    $output .= "ikey     = $key\n"; +    $output .= "skey     = $secret\n"; +    $output .= "api_host = $hostname\n"; +    $output .= "client   = radius_client\n"; + +    return $output; +} + +# Output for the LDAP proxy, which can be plugged into the proxy config. +sub _output_ldap { +    my ($key, $secret, $hostname) = @_; + +    my $output = "[ldap_server_challenge]\n"; +    $output .= "ikey     = $key\n"; +    $output .= "skey     = $secret\n"; +    $output .= "api_host = $hostname\n"; + +    return $output; +}  ##############################################################################  # Core methods @@ -86,7 +179,7 @@ sub new {  # great here since we don't have a way to communicate the error back to the  # caller.  sub create { -    my ($class, $type, $name, $schema, $creator, $host, $time, $duo_type) = @_; +    my ($class, $type, $name, $schema, $creator, $host, $time) = @_;      # We have to have a Duo integration key file set.      if (not $Wallet::Config::DUO_KEY_FILE) { @@ -95,6 +188,12 @@ sub create {      my $key_file = $Wallet::Config::DUO_KEY_FILE;      my $agent    = $Wallet::Config::DUO_AGENT; +    # Make sure this is actually a type we know about, since this handler +    # can handle many types. +    if (!exists $DUO_TYPES{$type}) { +        die "$type is not a valid duo integration\n"; +    } +      # Construct the Net::Duo::Admin object.      require Net::Duo::Admin;      my $duo = Net::Duo::Admin->new ( @@ -106,7 +205,7 @@ sub create {      # Create the object in Duo.      require Net::Duo::Admin::Integration; -    $duo_type ||= $Wallet::Config::DUO_TYPE; +    my $duo_type = $DUO_TYPES{$type}{integration};      my %data = (          name  => "$name ($duo_type)",          notes => 'Managed by wallet', @@ -201,11 +300,17 @@ sub get {      my $json = JSON->new->utf8 (1)->relaxed (1);      my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); -    # Construct the returned file. -    my $output; -    $output .= "Integration key: $key\n"; -    $output .= 'Secret key:      ' . $integration->secret_key . "\n"; -    $output .= "Host:            $config->{api_hostname}\n"; +    # Construct the returned file.  Assume the generic handler in case there +    # is no valid handler, though that shouldn't happen. +    my $output_sub; +    my $type = $self->{type}; +    if (exists $DUO_TYPES{$type}{output}) { +        $output_sub = $DUO_TYPES{$type}{output}; +    } else { +        $output_sub = \&_output_generic; +    } +    my $output = $output_sub->($key, $integration->secret_key, +                               $config->{api_hostname});      # Log the action and return.      $self->log_action ('get', $user, $host, $time); diff --git a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm b/perl/lib/Wallet/Object/Duo/LDAPProxy.pm deleted file mode 100644 index 23894ac..0000000 --- a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm +++ /dev/null @@ -1,202 +0,0 @@ -# Wallet::Object::Duo::LDAPProxy -- Duo auth proxy integration for LDAP -# -# Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -#     The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::LDAPProxy; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module.  Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { -    my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - -    $time ||= time; -    my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, -                                      $time, 'ldapproxy'); -    return $self; -} - -# Override get to output the data in a specific format used for Duo LDAP -# integration -sub get { -    my ($self, $user, $host, $time) = @_; -    $time ||= time; - -    # Check that the object isn't locked. -    my $id = $self->{type} . ':' . $self->{name}; -    if ($self->flag_check ('locked')) { -        $self->error ("cannot get $id: object is locked"); -        return; -    } - -    # Retrieve the integration from Duo. -    my $key; -    eval { -        my %search = (du_name => $self->{name}); -        my $row = $self->{schema}->resultset ('Duo')->find (\%search); -        $key = $row->get_column ('du_key'); -    }; -    if ($@) { -        $self->error ($@); -        return; -    } -    my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - -    # We also need the admin server name, which we can get from the Duo object -    # configuration with a bit of JSON decoding. -    my $json = JSON->new->utf8 (1)->relaxed (1); -    my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - -    # Construct the returned file. -    my $output = "[ldap_server_challenge]\n"; -    $output .= "ikey     = $key\n"; -    $output .= 'skey     = ' . $integration->secret_key . "\n"; -    $output .= "api_host = $config->{api_hostname}\n"; - -    # Log the action and return. -    $self->log_action ('get', $user, $host, $time); -    return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab LDAP auth - -=head1 NAME - -Wallet::Object::Duo::LDAPProxy - Duo auth proxy integration for LDAP - -=head1 SYNOPSIS - -    my @name = qw(duo-ldap host.example.com); -    my @trace = ($user, $host, time); -    my $object = Wallet::Object::Duo::LDAPProxy->create (@name, $schema, @trace); -    my $config = $object->get (@trace); -    $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::LDAPProxy is a representation of Duo -integrations with the wallet, specifically to output Duo integrations -in a format that can easily be pulled into configuring the Duo -Authentication Proxy for LDAP. It implements the wallet object API -and provides the necessary glue to create a Duo integration, return a -configuration file containing the key and API information for that -integration, and delete the integration from Duo when the wallet object -is destroyed. - -The integration information is always returned in the configuration file -format expected by the Authentication Proxy for Duo in configuring it -for LDAP. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations.  To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set.  See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo.  See the -documentation for that class for all generic methods.  Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo.  It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-ldap> and -must be for the rest of the wallet system to use the right class, but -this module doesn't check for ease of subclassing), using DBH as the -handle to the wallet metadata database.  PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information.  PRINCIPAL should be the -user who is creating the object.  If DATETIME isn't given, the current -time is used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object.  If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration.  Returns undef on failure.  The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - -    [ldap_server_challenge] -    ikey     = <integration-key> -    skey     = <secret-key> -    api_host = <api-hostname> - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab.  If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system.  The current version is -available from L<http://www.eyrie.org/~eagle/software/wallet/>. - -=head1 AUTHORS - -Jon Robertson <jonrober@stanford.edu> - -=cut diff --git a/perl/lib/Wallet/Object/Duo/PAM.pm b/perl/lib/Wallet/Object/Duo/PAM.pm deleted file mode 100644 index d9d17f8..0000000 --- a/perl/lib/Wallet/Object/Duo/PAM.pm +++ /dev/null @@ -1,205 +0,0 @@ -# Wallet::Object::Duo::PAM -- Duo PAM int. object implementation for wallet -# -# Written by Russ Allbery <eagle@eyrie.org> -#            Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -#     The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::PAM; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module.  Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { -    my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - -    $time ||= time; -    my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, -                                      $time, 'unix'); -    return $self; -} - -# Override get to output the data in a specific format used by Duo's PAM -# module. -sub get { -    my ($self, $user, $host, $time) = @_; -    $time ||= time; - -    # Check that the object isn't locked. -    my $id = $self->{type} . ':' . $self->{name}; -    if ($self->flag_check ('locked')) { -        $self->error ("cannot get $id: object is locked"); -        return; -    } - -    # Retrieve the integration from Duo. -    my $key; -    eval { -        my %search = (du_name => $self->{name}); -        my $row = $self->{schema}->resultset ('Duo')->find (\%search); -        $key = $row->get_column ('du_key'); -    }; -    if ($@) { -        $self->error ($@); -        return; -    } -    my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - -    # We also need the admin server name, which we can get from the Duo object -    # configuration with a bit of JSON decoding. -    my $json = JSON->new->utf8 (1)->relaxed (1); -    my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - -    # Construct the returned file. -    my $output = "[duo]\n"; -    $output .= "ikey = $key\n"; -    $output .= 'skey = ' . $integration->secret_key . "\n"; -    $output .= "host = $config->{api_hostname}\n"; - -    # Log the action and return. -    $self->log_action ('get', $user, $host, $time); -    return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab - -=head1 NAME - -Wallet::Object::Duo::PAM - Duo PAM int. object implementation for wallet - -=head1 SYNOPSIS - -    my @name = qw(duo-pam host.example.com); -    my @trace = ($user, $host, time); -    my $object = Wallet::Object::Duo::PAM->create (@name, $schema, @trace); -    my $config = $object->get (@trace); -    $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::PAM is a representation of Duo integrations with -the wallet, specifically to output Duo integrations in a format that -can easily be pulled into configuring the Duo PAM interface.  It -implements the wallet object API and provides the necessary glue to -create a Duo integration, return a configuration file containing the key -and API information for that integration, and delete the integration from -Duo when the wallet object is destroyed. - -The integration information is always returned in the configuration file -format expected by the Duo UNIX integration.  The results of retrieving -this object will be text, suitable for putting in the UNIX integration -configuration file, containing the integration key, secret key, and admin -hostname for that integration. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations.  To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set.  See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo.  See the -documentation for that class for all generic methods.  Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo.  It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-pam> and must -be for the rest of the wallet system to use the right class, but this -module doesn't check for ease of subclassing), using DBH as the handle -to the wallet metadata database.  PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information.  PRINCIPAL should be the user who is -creating the object.  If DATETIME isn't given, the current time is -used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object.  If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration.  Returns undef on failure.  The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - -    [duo] -    ikey = <integration-key> -    skey = <secret-key> -    host = <api-hostname> - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab.  If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system.  The current version is -available from L<http://www.eyrie.org/~eagle/software/wallet/>. - -=head1 AUTHORS - -Russ Allbery <eagle@eyrie.org> -Jon Robertson <eagle@eyrie.org> - -=cut diff --git a/perl/lib/Wallet/Object/Duo/RDP.pm b/perl/lib/Wallet/Object/Duo/RDP.pm deleted file mode 100644 index c74661c..0000000 --- a/perl/lib/Wallet/Object/Duo/RDP.pm +++ /dev/null @@ -1,204 +0,0 @@ -# Wallet::Object::Duo::RDP -- Duo RDP int. object implementation for wallet -# -# Written by Russ Allbery <eagle@eyrie.org> -#            Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -#     The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::RDP; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module.  Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { -    my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - -    $time ||= time; -    my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, -                                      $time, 'rdp'); -    return $self; -} - -# Override get to output the data in a specific format used by Duo's RDP -# module. -sub get { -    my ($self, $user, $host, $time) = @_; -    $time ||= time; - -    # Check that the object isn't locked. -    my $id = $self->{type} . ':' . $self->{name}; -    if ($self->flag_check ('locked')) { -        $self->error ("cannot get $id: object is locked"); -        return; -    } - -    # Retrieve the integration from Duo. -    my $key; -    eval { -        my %search = (du_name => $self->{name}); -        my $row = $self->{schema}->resultset ('Duo')->find (\%search); -        $key = $row->get_column ('du_key'); -    }; -    if ($@) { -        $self->error ($@); -        return; -    } -    my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - -    # We also need the admin server name, which we can get from the Duo object -    # configuration with a bit of JSON decoding. -    my $json = JSON->new->utf8 (1)->relaxed (1); -    my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - -    # Construct the returned file. -    my $output; -    $output .= "Integration key: $key\n"; -    $output .= 'Secret key:      ' . $integration->secret_key . "\n"; -    $output .= "Host:            $config->{api_hostname}\n"; - -    # Log the action and return. -    $self->log_action ('get', $user, $host, $time); -    return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab RDP - -=head1 NAME - -Wallet::Object::Duo::RDP - Duo RDP int. object implementation for wallet - -=head1 SYNOPSIS - -    my @name = qw(duo-rdp host.example.com); -    my @trace = ($user, $host, time); -    my $object = Wallet::Object::Duo::RDP->create (@name, $schema, @trace); -    my $config = $object->get (@trace); -    $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::RDP is a representation of Duo integrations with -the wallet, specifically to output Duo integrations to set up an RDP -integration.  This can be used to set up remote logins, or all Windows -logins period if so selected in Duo's software.  It implements the -wallet object API and provides the necessary glue to create a Duo -integration, return a configuration file containing the key and API -information for that integration, and delete the integration from Duo -when the wallet object is destroyed. - -Because the Duo RDP software is configured by a GUI, the information -returned for a get operation is a simple set that's readable but not -useful for directly plugging into a config file.  The values would need -to be cut and pasted into the GUI. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations.  To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set.  See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo.  See the -documentation for that class for all generic methods.  Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo.  It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-pam> and must -be for the rest of the wallet system to use the right class, but this -module doesn't check for ease of subclassing), using DBH as the handle -to the wallet metadata database.  PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information.  PRINCIPAL should be the user who is -creating the object.  If DATETIME isn't given, the current time is -used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object.  If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration.  Returns undef on failure.  The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - -    Integration key: <integration-key> -    Secret key:      <secret-key> -    Host:            <api-hostname> - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab.  If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system.  The current version is -available from L<http://www.eyrie.org/~eagle/software/wallet/>. - -=head1 AUTHORS - -Russ Allbery <eagle@eyrie.org> -Jon Robertson <eagle@eyrie.org> - -=cut diff --git a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm b/perl/lib/Wallet/Object/Duo/RadiusProxy.pm deleted file mode 100644 index a1f6e24..0000000 --- a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm +++ /dev/null @@ -1,204 +0,0 @@ -# Wallet::Object::Duo::RadiusProxy -- Duo auth proxy integration for radius -# -# Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -#     The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::RadiusProxy; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module.  Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { -    my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - -    $time ||= time; -    my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, -                                      $time, 'radius'); -    return $self; -} - -# Override get to output the data in a specific format used for Duo radius -# integration -sub get { -    my ($self, $user, $host, $time) = @_; -    $time ||= time; - -    # Check that the object isn't locked. -    my $id = $self->{type} . ':' . $self->{name}; -    if ($self->flag_check ('locked')) { -        $self->error ("cannot get $id: object is locked"); -        return; -    } - -    # Retrieve the integration from Duo. -    my $key; -    eval { -        my %search = (du_name => $self->{name}); -        my $row = $self->{schema}->resultset ('Duo')->find (\%search); -        $key = $row->get_column ('du_key'); -    }; -    if ($@) { -        $self->error ($@); -        return; -    } -    my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - -    # We also need the admin server name, which we can get from the Duo object -    # configuration with a bit of JSON decoding. -    my $json = JSON->new->utf8 (1)->relaxed (1); -    my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - -    # Construct the returned file. -    my $output = "[radius_server_challenge]\n"; -    $output .= "ikey     = $key\n"; -    $output .= 'skey     = ' . $integration->secret_key . "\n"; -    $output .= "api_host = $config->{api_hostname}\n"; -    $output .= "client   = radius_client\n"; - -    # Log the action and return. -    $self->log_action ('get', $user, $host, $time); -    return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab auth - -=head1 NAME - -Wallet::Object::Duo::RadiusProxy - Duo auth proxy integration for RADIUS - -=head1 SYNOPSIS - -    my @name = qw(duo-radius host.example.com); -    my @trace = ($user, $host, time); -    my $object = Wallet::Object::Duo::RadiusProxy->create (@name, $schema, @trace); -    my $config = $object->get (@trace); -    $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::RadiusProxy is a representation of Duo -integrations with the wallet, specifically to output Duo integrations -in a format that can easily be pulled into configuring the Duo -Authentication Proxy for Radius. It implements the wallet object API -and provides the necessary glue to create a Duo integration, return a -configuration file containing the key and API information for that -integration, and delete the integration from Duo when the wallet object -is destroyed. - -The integration information is always returned in the configuration file -format expected by the Authentication Proxy for Duo in configuring it -for Radius. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations.  To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set.  See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo.  See the -documentation for that class for all generic methods.  Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo.  It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-radius> and -must be for the rest of the wallet system to use the right class, but -this module doesn't check for ease of subclassing), using DBH as the -handle to the wallet metadata database.  PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information.  PRINCIPAL should be the -user who is creating the object.  If DATETIME isn't given, the current -time is used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object.  If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration.  Returns undef on failure.  The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - -    [radius_server_challenge] -    ikey     = <integration-key> -    skey     = <secret-key> -    api_host = <api-hostname> -    client   = radius_client - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab.  If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system.  The current version is -available from L<http://www.eyrie.org/~eagle/software/wallet/>. - -=head1 AUTHORS - -Jon Robertson <jonrober@stanford.edu> - -=cut diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 975179b..c625766 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -29,6 +29,37 @@ use Wallet::Kadmin;  $VERSION = '0.09';  ############################################################################## +# Shared methods +############################################################################## + +# Generate a keytab into a temporary file and then return that as the return +# value.  Used by both get and update, as the only difference is how we +# handle the unchanging flag. +sub retrieve { +    my ($self, $operation, $user, $host, $time) = @_; +    $time ||= time; +    my $id = $self->{type} . ':' . $self->{name}; +    if ($self->flag_check ('locked')) { +        $self->error ("cannot get $id: object is locked"); +        return; +    } +    my $kadmin = $self->{kadmin}; +    my $result; +    if ($operation eq 'get' && $self->flag_check ('unchanging')) { +        $result = $kadmin->keytab ($self->{name}); +    } else { +        my @enctypes = $self->attr ('enctypes'); +        $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); +    } +    if (defined $result) { +        $self->log_action ($operation, $user, $host, $time); +    } else { +        $self->error ($kadmin->error); +    } +    return $result; +} + +##############################################################################  # Enctype restriction  ############################################################################## @@ -314,25 +345,15 @@ sub destroy {  # return that as the return value.  sub get {      my ($self, $user, $host, $time) = @_; -    $time ||= time; -    my $id = $self->{type} . ':' . $self->{name}; -    if ($self->flag_check ('locked')) { -        $self->error ("cannot get $id: object is locked"); -        return; -    } -    my $kadmin = $self->{kadmin}; -    my $result; -    if ($self->flag_check ('unchanging')) { -        $result = $kadmin->keytab ($self->{name}); -    } else { -        my @enctypes = $self->attr ('enctypes'); -        $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); -    } -    if (defined $result) { -        $self->log_action ('get', $user, $host, $time); -    } else { -        $self->error ($kadmin->error); -    } +    my $result = $self->retrieve ('get', $user, $host, $time); +    return $result; +} + +# Our update implementation.  Generate a new keytab regardless of the +# unchanging flag. +sub update { +    my ($self, $user, $host, $time) = @_; +    my $result = $self->retrieve ('update', $user, $host, $time);      return $result;  } diff --git a/perl/lib/Wallet/Object/Password.pm b/perl/lib/Wallet/Object/Password.pm new file mode 100644 index 0000000..3fd6ec8 --- /dev/null +++ b/perl/lib/Wallet/Object/Password.pm @@ -0,0 +1,228 @@ +# Wallet::Object::Password -- Password object implementation for the wallet. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2015 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Object::Password; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +use Crypt::GeneratePassword qw(chars); +use Digest::MD5 qw(md5_hex); +use Wallet::Config (); +use Wallet::Object::File; + +@ISA = qw(Wallet::Object::File); + +# This version should be increased on any code change to this module.  Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# File naming +############################################################################## + +# Returns the path into which that password object will be stored or undef on +# error.  On error, sets the internal error. +sub file_path { +    my ($self) = @_; +    my $name = $self->{name}; +    unless ($Wallet::Config::PWD_FILE_BUCKET) { +        $self->error ('password support not configured'); +        return; +    } +    unless ($name) { +        $self->error ('password objects may not have empty names'); +        return; +    } +    my $hash = substr (md5_hex ($name), 0, 2); +    $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; +    my $parent = "$Wallet::Config::PWD_FILE_BUCKET/$hash"; +    unless (-d $parent || mkdir ($parent, 0700)) { +        $self->error ("cannot create password bucket $hash: $!"); +        return; +    } +    return "$Wallet::Config::PWD_FILE_BUCKET/$hash/$name"; +} + +############################################################################## +# Shared methods +############################################################################## + +# Return the contents of the file. +sub retrieve { +    my ($self, $operation, $user, $host, $time) = @_; +    $time ||= time; +    my $id = $self->{type} . ':' . $self->{name}; +    if ($self->flag_check ('locked')) { +        $self->error ("cannot get $id: object is locked"); +        return; +    } +    my $path = $self->file_path; +    return unless $path; + +    # If nothing is yet stored, or we have requested an update, generate a +    # random password and save it to the file. +    my $schema = $self->{schema}; +    my %search = (ob_type => $self->{type}, +                  ob_name => $self->{name}); +    my $object = $schema->resultset('Object')->find (\%search); +    if (!$object->ob_stored_on || $operation eq 'update') { +        unless (open (FILE, '>', $path)) { +            $self->error ("cannot store initial settings for $id: $!\n"); +            return; +        } +        my $pass = chars ($Wallet::Config::PWD_LENGTH_MIN, +                          $Wallet::Config::PWD_LENGTH_MAX); +        print FILE $pass; +        $self->log_action ('store', $user, $host, $time); +        unless (close FILE) { +            $self->error ("cannot get $id: $!"); +            return; +        } +    } + +    unless (open (FILE, '<', $path)) { +        $self->error ("cannot get $id: object has not been stored"); +        return; +    } +    local $/; +    my $data = <FILE>; +    unless (close FILE) { +        $self->error ("cannot get $id: $!"); +        return; +    } +    $self->log_action ($operation, $user, $host, $time); +    return $data; +} + +############################################################################## +# Core methods +############################################################################## + +# Return the contents of the file. +sub get { +    my ($self, $user, $host, $time) = @_; +    my $result = $self->retrieve ('get', $user, $host, $time); +    return $result; +} + +# Return the contents of the file after resetting them to a random string. +sub update { +    my ($self, $user, $host, $time) = @_; +    my $result = $self->retrieve ('update', $user, $host, $time); +    return $result; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Object::Password - Password object implementation for wallet + +=for stopwords +API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend + +=head1 SYNOPSIS + +    my @name = qw(file mysql-lsdb) +    my @trace = ($user, $host, time); +    my $object = Wallet::Object::Password->create (@name, $schema, @trace); +    unless ($object->store ("the-password\n")) { +        die $object->error, "\n"; +    } +    my $password = $object->get (@trace); +    $object->destroy (@trace); + +=head1 DESCRIPTION + +Wallet::Object::Password is an extension of Wallet::Object::File, +acting as a representation of simple file objects in the wallet.  The +difference between the two is that if there is no data stored in a +password object when a user tries to get it for the first time, then a +random string suited for a password will be generated and put into the +object data. + +It implements the wallet object API and provides the necessary +glue to store a file on the wallet server, retrieve it later, and delete +it when the password object is deleted. + +To use this object, the configuration option specifying where on the +wallet server to store password objects must be set.  See +L<Wallet::Config> for details on this configuration parameter and +information about how to set wallet configuration. + +=head1 METHODS + +This object mostly inherits from Wallet::Object::File.  See the +documentation for that class for all generic methods.  Below are only +those methods that are overridden or behave specially for this +implementation. + +=over 4 + +=item get(PRINCIPAL, HOSTNAME [, DATETIME]) + +Retrieves the current contents of the file object or undef on error. +store() must be called before get() will be successful.  The caller should +call error() to get the error message if get() returns undef.  PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information.  PRINCIPAL +should be the user who is downloading the keytab.  If DATETIME isn't +given, the current time is used. + +=back + +=head1 FILES + +=over 4 + +=item PWD_FILE_BUCKET/<hash>/<file> + +Password files are stored on the wallet server under the directory +PWD_FILE_BUCKET as set in the wallet configuration.  <hash> is the +first two characters of the hex-encoded MD5 hash of the wallet password +object name, used to not put too many files in the same directory. +<file> is the name of the password object with all characters other +than alphanumerics, underscores, and dashes replaced by C<%> and the +hex code of the character. + +=back + +=head1 LIMITATIONS + +The wallet implementation itself can handle arbitrary password object +names. However, due to limitations in the B<remctld> server usually +used to run B<wallet-backend>, password object names containing nul +characters (ASCII 0) may not be permitted.  The file system used for +storing file objects may impose a length limitation on the +password object name. + +=head1 SEE ALSO + +remctld(8), Wallet::Config(3), Wallet::Object::File(3), +wallet-backend(8) + +This module is part of the wallet system.  The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHOR + +Jon Robertson <jonrober@stanford.edu> + +=cut diff --git a/perl/lib/Wallet/Policy/Stanford.pm b/perl/lib/Wallet/Policy/Stanford.pm index a392476..86e204e 100644 --- a/perl/lib/Wallet/Policy/Stanford.pm +++ b/perl/lib/Wallet/Policy/Stanford.pm @@ -25,8 +25,8 @@ our (@EXPORT_OK, $VERSION);  # against circular module loading (not that we load any modules, but  # consistency is good).  BEGIN { -    $VERSION   = '1.00'; -    @EXPORT_OK = qw(default_owner verify_name); +    $VERSION   = '1.01'; +    @EXPORT_OK = qw(default_owner verify_name is_for_host);  }  ############################################################################## @@ -66,8 +66,9 @@ our %FILE_TYPE = (      'password-root'   => { host => 1 },      'password-tivoli' => { host => 1 },      properties        => {            extra => 1 }, -    'ssh-dsa'         => { host => 1 }, -    'ssh-rsa'         => { host => 1 }, +    'ssh-dsa'         => { host => 1, extra => 1 }, +    'ssh-rsa'         => { host => 1, extra => 1 }, +    'ssl-chain'       => { host => 1, extra => 1 },      'ssl-key'         => { host => 1, extra => 1 },      'ssl-keypair'     => { host => 1, extra => 1 },      'ssl-keystore'    => {            extra => 1 }, @@ -75,6 +76,29 @@ our %FILE_TYPE = (      'tivoli-key'      => { host => 1 },  ); +# Password object types.  Most of these mimic file object types (which should +# be gradually phased out). +our %PASSWORD_TYPE = ( +    'ipmi'            => { host => 1 }, +    'root'            => { host => 1 }, +    'tivoli'          => { host => 1 }, +    'system'          => { host => 1, extra => 1, need_extra => 1 }, +    'app'             => { host => 1, extra => 1, need_extra => 1 }, +    'service'         => {            extra => 1, need_extra => 1 }, +); + +# Mappings that let us determine the host for a host-based object, if any. +our %HOST_FOR = ( +    'keytab'     => \&_host_for_keytab, +    'file'       => \&_host_for_file, +    'password'   => \&_host_for_password, +    'duo'        => \&_host_for_duo, +    'duo-pam'    => \&_host_for_duo, +    'duo-radius' => \&_host_for_duo, +    'duo-ldap'   => \&_host_for_duo, +    'duo-rdp'    => \&_host_for_duo, +); +  # Host-based file object types for the legacy file object naming scheme.  our @FILE_HOST_LEGACY = qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key); @@ -144,6 +168,17 @@ sub _host_for_file_legacy {      return $host;  } +# Map a password object name to a hostname.  Returns undef if this password +# object name doesn't map to a hostname. +sub _host_for_password { +    my ($name) = @_; + +    # Parse the name and check whether this is a host-based object. +    my ($type, $host) = split('/', $name); +    return if !$PASSWORD_TYPE{$type}{host}; +    return $host; +} +  # Map a file object name to a hostname.  Returns undef if this file object  # name doesn't map to a hostname.  sub _host_for_file { @@ -181,6 +216,23 @@ sub _host_for_duo {      return $name;  } +# Take a object type and name, along with a host name, and use these to +# decide if the given object is host-based and matches the given host. +sub is_for_host { +    my ($type, $name, $host) = @_; + +    # If we have a possible host mapping, get the host and see if it matches. +    if (defined($HOST_FOR{$type})) { +        my $object_host = $HOST_FOR{$type}->($name); +        return 0 unless $object_host; +        if ($host eq $object_host) { +            return 1; +        } +    } + +    return 0; +} +  # The default owner of host-based objects should be the host keytab and the  # NetDB ACL for that host, with one twist.  If the creator of a new node is  # using a root instance, we want to require everyone managing that node be @@ -188,20 +240,9 @@ sub _host_for_duo {  sub default_owner {      my ($type, $name) = @_; -    # How to determine the host for host-based objects. -    my %host_for = ( -        'keytab'     => \&_host_for_keytab, -        'file'       => \&_host_for_file, -        'duo'        => \&_host_for_duo, -        'duo-pam'    => \&_host_for_duo, -        'duo-radius' => \&_host_for_duo, -        'duo-ldap'   => \&_host_for_duo, -        'duo-rdp'    => \&_host_for_duo, -    ); -      # If we have a possible host mapping, see if we can use that. -    if (defined($host_for{$type})) { -        my $host = $host_for{$type}->($name); +    if (defined($HOST_FOR{$type})) { +        my $host = $HOST_FOR{$type}->($name);          if ($host) {              my $acl_name = "host/$host";              my @acl; @@ -242,7 +283,7 @@ sub default_owner {  # hostnames, limit the acceptable characters for service/* keytabs, and  # enforce our naming constraints on */cgi principals.  # -# Also use this function to require that IDG staff always do implicit object +# Also use this function to require that ACS staff always do implicit object  # creation using a */root instance.  sub verify_name {      my ($type, $name, $user) = @_; @@ -363,6 +404,8 @@ sub verify_name {                  return "missing component in $name";              }              return; + +          } else {              # Legacy naming scheme.              my %groups = map { $_ => 1 } @GROUPS_LEGACY; @@ -380,6 +423,71 @@ sub verify_name {          }      } +    # Check password object naming conventions. +    if ($type eq 'password') { +        if ($name =~ m{ / }xms) { +            my @name = split('/', $name); + +            # Names have between two and four components and all must be +            # non-empty. +            if (@name > 4) { +                return "too many components in $name"; +            } +            if (@name < 2) { +                return "too few components in $name"; +            } +            if (grep { $_ eq q{} } @name) { +                return "empty component in $name"; +            } + +            # All objects start with the type.  First check if this is a +            # host-based type. +            my $type = shift @name; +            if ($PASSWORD_TYPE{$type} && $PASSWORD_TYPE{$type}{host}) { +                my ($host, $extra) = @name; +                if ($host !~ m{ [.] }xms) { +                    return "host name $host is not fully qualified"; +                } +                if (defined($extra) && !$PASSWORD_TYPE{$type}{extra}) { +                    return "extraneous component at end of $name"; +                } +                if (!defined($extra) && $PASSWORD_TYPE{$type}{need_extra}) { +                    return "missing component in $name"; +                } +                return; +            } + +            # Otherwise, the name is group-based.  There be at least two +            # remaining components. +            if (@name < 2) { +                return "too few components in $name"; +            } +            my ($group, $service, $extra) = @name; + +            # Check the group. +            if (!$ACL_FOR_GROUP{$group}) { +                return "unknown group $group"; +            } + +            # Check the type.  Be sure it's not host-based. +            if (!$PASSWORD_TYPE{$type}) { +                return "unknown type $type"; +            } +            if ($PASSWORD_TYPE{$type}{host}) { +                return "bad name for host-based file type $type"; +            } + +            # Check the extra data. +            if (defined($extra) && !$PASSWORD_TYPE{$type}{extra}) { +                return "extraneous component at end of $name"; +            } +            if (!defined($extra) && $PASSWORD_TYPE{$type}{need_extra}) { +                return "missing component in $name"; +            } +            return; +        } +    } +      # Check the naming conventions for all Duo object types.  The object      # should simply be the host name for now.      if ($type =~ m{^duo(-\w+)?$}) { diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index bf48308..353cd97 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -175,6 +175,20 @@ sub objects_unused {      return (\%search, \%options);  } +# Return the SQL statement to find all fiel objects that have been created +# but have never had information stored (via store). +sub objects_unstored { +    my ($self) = @_; +    my @objects; + +    my %search = (ob_stored_on => undef, +                  ob_type      => 'file'); +    my %options = (order_by => [ qw/ob_type ob_name/ ], +                   select   => [ qw/ob_type ob_name/ ]); + +    return (\%search, \%options); +} +  # Returns a list of all objects stored in the wallet database in the form of  # type and name pairs.  On error and for an empty database, the empty list  # will be returned.  To distinguish between an empty list and an error, call @@ -190,7 +204,7 @@ sub objects {      if (!defined $type || $type eq '') {          ($search_ref, $options_ref) = $self->objects_all;      } else { -        if ($type ne 'unused' && @args != 1) { +        if ($type ne 'unused' && $type ne 'unstored' && @args != 1) {              $self->error ("object searches require one argument to search");          } elsif ($type eq 'type') {              ($search_ref, $options_ref) = $self->objects_type (@args); @@ -202,6 +216,8 @@ sub objects {              ($search_ref, $options_ref) = $self->objects_acl (@args);          } elsif ($type eq 'unused') {              ($search_ref, $options_ref) = $self->objects_unused (@args); +        } elsif ($type eq 'unstored') { +            ($search_ref, $options_ref) = $self->objects_unstored (@args);          } else {              $self->error ("do not know search type: $type");          } @@ -226,12 +242,124 @@ sub objects {      return @objects;  } +# Returns a list of all object_history records stored in the wallet database +# including all of their fields.  On error and for an empty database, the +# empty list will be returned.  To distinguish between an empty list and an +# error, call error(), which will return undef if there was no error. +# Farms out specific statement to another subroutine for specific search +# types, but each case should return ob_type and ob_name in that order. +sub objects_history { +    my ($self, $search_type, @args) = @_; +    undef $self->{error}; + +    # All fields in the order we want to see them. +    my @fields = ('oh_on', 'oh_by', 'oh_type', 'oh_name', 'oh_action', +                  'oh_from'); + +    # Get the search and options array refs from specific functions. +    my %search  = (); +    my %options = (order_by => \@fields, +                   select   => \@fields); + +    # Perform the search and return on any errors. +    my @objects; +    my $schema = $self->{schema}; +    eval { +        my @objects_rs +            = $schema->resultset('ObjectHistory')->search (\%search, +                                                           \%options); +        for my $object_rs (@objects_rs) { +            my @rec; +            for my $field (@fields) { +                push (@rec, $object_rs->get_column($field)); +            } +            push (@objects, \@rec); +        } +    }; +    if ($@) { +        $self->error ("cannot list objects: $@"); +        return; +    } + +    return @objects; +} + +# Returns a list of all objects stored in the wallet database in the form of +# type and name pairs.  On error and for an empty database, the empty list +# will be returned.  To distinguish between an empty list and an error, call +# error(), which will return undef if there was no error.  Farms out specific +# statement to another subroutine for specific search types, but each case +# should return ob_type and ob_name in that order. +sub objects_hostname { +    my ($self, $type, $hostname) = @_; +    undef $self->{error}; + +    # Make sure we have a given hostname. +    if (!$hostname) { +        $self->error ("object hosts requires one argument to search"); +        return; +    } + +    # If we don't have a way to get host-based object lists, quit. +    unless (defined &Wallet::Config::is_for_host) { +        $self->error ('no host-based policy defined'); +        return; +    } + +    # Search on all objects. +    my %search = (); +    my %options = (order_by => [ qw/ob_type ob_name/ ], +                   select   => [ qw/ob_type ob_name/ ]); + +    my @objects; +    my $schema = $self->{schema}; +    eval { +        my @objects_rs = $schema->resultset('Object')->search (\%search, +                                                               \%options); + +        # Check to see if an object is for the given host and add to list if +        # so. +        for my $object_rs (@objects_rs) { +            my $type = $object_rs->ob_type; +            my $name = $object_rs->ob_name; +            next unless &Wallet::Config::is_for_host($type, $name, $hostname); +            push (@objects, [ $type, $name ]); +        } +    }; +    if ($@) { +        $self->error ("cannot list objects: $@"); +        return; +    } + +    return @objects; +} + +############################################################################## +# Type reports +############################################################################## + +# Return an alphabetical list of all valid types set up, along with the class +# that they belong to. +sub types { +    my ($self) = @_; + +    my (@types); +    my @types_rs = $self->{schema}->resultset('Type')->all; +    for my $type_rs (@types_rs) { +        my $name  = $type_rs->ty_name; +        my $class = $type_rs->ty_class; +        push(@types, [ $name, $class ]); +    } + +    @types = sort { $a->[0] cmp $b->[0] } @types; +    return @types; +} +  ##############################################################################  # ACL reports  ############################################################################## -# Returns the SQL statement required to find and return all ACLs in the -# database. +# Returns the array of all ACLs in the database.  sub acls_all {      my ($self) = @_;      my @acls; @@ -255,7 +383,7 @@ sub acls_all {      return (@acls);  } -# Returns the SQL statement required to find all empty ACLs in the database. +# Returns the array of all empty ACLs in the database.  sub acls_empty {      my ($self) = @_;      my @acls; @@ -281,9 +409,36 @@ sub acls_empty {      return (@acls);  } -# Returns the SQL statement and the field required to find ACLs containing the -# specified entry.  The identifier is automatically surrounded by wildcards to -# do a substring search. +# Returns the array of ACLs that nest a given ACL. +sub acls_nesting { +    my ($self, $name) = @_; +    my @acls; + +    my $schema = $self->{schema}; +    my %search = (ae_scheme     => 'nested', +                  ae_identifier => $name); +    my %options = (join     => 'acl_entries', +                   prefetch => 'acl_entries', +                   order_by => [ qw/ac_id/ ], +                   select   => [ qw/ac_id ac_name/ ]); + +    eval { +        my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); +        for my $acl_rs (@acls_rs) { +            push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); +        } +    }; + +    if ($@) { +        $self->error ("cannot list ACLs: $@"); +        return; +    } +    return (@acls); +} + +# Returns the array of all ACLs containing the specified entry.  The given +# identifier is automatically surrounded by wildcards to do a substring +# search.  sub acls_entry {      my ($self, $type, $identifier) = @_;      my @acls; @@ -311,7 +466,7 @@ sub acls_entry {      return (@acls);  } -# Returns the SQL statement required to find unused ACLs. +# Returns the array of all unused ACLs.  sub acls_unused {      my ($self) = @_;      my @acls; @@ -424,6 +579,13 @@ sub acls {              @acls = $self->acls_empty;          } elsif ($type eq 'unused') {              @acls = $self->acls_unused; +        } elsif ($type eq 'nesting') { +            if (@args == 0) { +                $self->error ('ACL nesting search requires an ACL to search'); +                return; +            } else { +                @acls = $self->acls_nesting (@args); +            }          } else {              $self->error ("unknown search type: $type");              return; @@ -469,6 +631,23 @@ sub owners {      return @owners;  } +# Return an alphabetical list of all valid types set up, along with the class +# that they belong to. +sub acl_schemes { +    my ($self) = @_; + +    my (@schemes); +    my @acls_rs = $self->{schema}->resultset('AclScheme')->all; +    for my $acl_rs (@acls_rs) { +        my $name  = $acl_rs->as_name; +        my $class = $acl_rs->as_class; +        push(@schemes, [ $name, $class ]); +    } + +    @schemes = sort { $a->[0] cmp $b->[0] } @schemes; +    return @schemes; +} +  ##############################################################################  # Auditing  ############################################################################## @@ -633,14 +812,17 @@ Returns a list of all objects matching a search type and string in the  database, or all objects in the database if no search information is  given. -There are five types of searches currently.  C<type>, with a given type, -will return only those entries where the type matches the given type. -C<owner>, with a given owner, will only return those objects owned by the -given ACL name or ID.  C<flag>, with a given flag name, will only return -those items with a flag set to the given value.  C<acl> operates like -C<owner>, but will return only those objects that have the given ACL name -or ID on any of the possible ACL settings, not just owner.  C<unused> will -return all entries for which a get command has never been issued. +There are several types of searches.  C<type>, with a given type, will +return only those entries where the type matches the given type. +C<owner>, with a given owner, will only return those objects owned by +the given ACL name or ID.  C<flag>, with a given flag name, will only +return those items with a flag set to the given value.  C<acl> operates +like C<owner>, but will return only those objects that have the given +ACL name or ID on any of the possible ACL settings, not just owner. +C<unused> will return all entries for which a get command has never +been issued.  C<unstored> will return all entries for which a store +command has never been issued (limited to file type since storing isn't +needed for other types).  The return value is a list of references to pairs of type and name.  For  example, if two objects existed in the database, both of type C<keytab> @@ -654,6 +836,24 @@ empty search result, the caller should call error().  error() is  guaranteed to return the error message if there was an error and undef if  there was no error. +=item objects_history(TYPE) + +Returns a dump of the entire object history table.  The return value is +a list of references to each field in that table, in the following order: + +    oh_on, oh_by, oh_type, oh_name, oh_action, oh_from + +=item objects_hostname(TYPE, HOSTNAME) + +Returns a list of all host-based objects for a given hostname.  The +output is identical to the general objects command, but we need to +separate this out because the way it searches is very different. + +Returns the empty list on failure.  To distinguish between this and an +empty search result, the caller should call error().  error() is +guaranteed to return the error message if there was an error and undef if +there was no error. +  =item owners(TYPE, NAME)  Returns a list of all ACL lines contained in owner ACLs for objects diff --git a/perl/lib/Wallet/Schema.pm b/perl/lib/Wallet/Schema.pm index 5b850c0..386801a 100644 --- a/perl/lib/Wallet/Schema.pm +++ b/perl/lib/Wallet/Schema.pm @@ -114,6 +114,10 @@ Holds the supported ACL schemes and their corresponding Perl classes:    insert into acl_schemes (as_name, as_class)        values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute');    insert into acl_schemes (as_name, as_class) +      values ('ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root'); +  insert into acl_schemes (as_name, as_class) +      values ('nested', 'Wallet::ACL::Nested'); +  insert into acl_schemes (as_name, as_class)        values ('netdb', 'Wallet::ACL::NetDB');    insert into acl_schemes (as_name, as_class)        values ('netdb-root', 'Wallet::ACL::NetDB::Root'); diff --git a/perl/lib/Wallet/Schema/Result/AclScheme.pm b/perl/lib/Wallet/Schema/Result/AclScheme.pm index 91a58b2..be4ec09 100644 --- a/perl/lib/Wallet/Schema/Result/AclScheme.pm +++ b/perl/lib/Wallet/Schema/Result/AclScheme.pm @@ -36,6 +36,10 @@ By default it contains the following entries:    insert into acl_schemes (as_name, as_class)        values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute');    insert into acl_schemes (as_name, as_class) +      values ('ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root'); +  insert into acl_schemes (as_name, as_class) +      values ('nested', 'Wallet::ACL::Nested'); +  insert into acl_schemes (as_name, as_class)        values ('netdb', 'Wallet::ACL::NetDB');    insert into acl_schemes (as_name, as_class)        values ('netdb-root', 'Wallet::ACL::NetDB::Root'); diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index f6ea342..946ba10 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -154,8 +154,8 @@ sub create_check {              $self->error ($acl->error);              return;          } -        @entries = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @entries; -        @acl     = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @acl; +        @entries = sort { $$a[0] cmp $$b[0] || $$a[1] cmp $$b[1] } @entries; +        @acl     = sort { $$a[0] cmp $$b[0] || $$a[1] cmp $$b[1] } @acl;          my $okay = 1;          if (@entries != @acl) {              $okay = 0; @@ -516,6 +516,21 @@ sub get {      return $result;  } +# Retrieve the information associated with an object, updating the current +# information if we are of a type that allows autogenerated information. +# Returns undef and sets the internal error if the retrieval fails or if the +# user isn't authorized.  If the object doesn't exist, attempts dynamic +# creation of the object using the default ACL mappings (if any). +sub update { +    my ($self, $type, $name) = @_; +    my $object = $self->retrieve ($type, $name); +    return unless defined $object; +    return unless $self->acl_verify ($object, 'get'); +    my $result = $object->update ($self->{user}, $self->{host}); +    $self->error ($object->error) unless defined $result; +    return $result; +} +  # Store new data in an object, or returns undef and sets the internal error if  # the object can't be found or if the user isn't authorized.  Also don't  # permit storing undef, although storing the empty string is fine.  If the @@ -734,6 +749,36 @@ sub acl_rename {      return 1;  } +# Move all ACLs owned by one ACL to another, or return undef and set the +# internal error. +sub acl_replace { +    my ($self, $old_id, $replace_id) = @_; +    unless ($self->{admin}->check ($self->{user})) { +        $self->acl_error ($old_id, 'replace'); +        return; +    } +    my $acl = eval { Wallet::ACL->new ($old_id, $self->{schema}) }; +    if ($@) { +        $self->error ($@); +        return; +    } +    if ($acl->name eq 'ADMIN') { +        $self->error ('cannot replace the ADMIN ACL'); +        return; +    } +    my $replace_acl = eval { Wallet::ACL->new ($replace_id, $self->{schema}) }; +    if ($@) { +        $self->error ($@); +        return; +    } + +    unless ($acl->replace ($replace_id, $self->{user}, $self->{host})) { +        $self->error ($acl->error); +        return; +    } +    return 1; +} +  # Destroy an ACL, deleting it out of the database.  Returns true on success.  # On failure, returns undef, setting the internal error.  sub acl_destroy { @@ -942,6 +987,14 @@ either the current name or the numeric ID.  NEW must not be all-numeric.  To rename an ACL, the current user must be authorized by the ADMIN ACL.  Returns true on success and false on failure. +=item acl_replace(OLD, NEW) + +Moves any object owned by the ACL identified by OLD to be instead owned by +NEW.  This goes through all objects owned by OLD and individually changes +the owner, along with history updates.  OLD and NEW may be either the name +or the numeric ID.  To replace an ACL, the current user must be authorized +by the ADMIN ACL.  Returns true on success and false on failure. +  =item acl_show(ID)  Returns a human-readable description, including membership, of the ACL | 
