Add acl comment and some build chagnes

perl/lib/Wallet/ACL.pm

@@ -22,6 +22,8 @@ use Wallet::Object::Base;
 
 our $VERSION = '1.04';
 
+my $TZ = DateTime::TimeZone->new( name => 'local' );
+
 ##############################################################################
 # Constructors
 ##############################################################################
@@ -50,6 +52,7 @@ sub new {
         schema  => $schema,
         id      => $data->ac_id,
         name    => $data->ac_name,
+        comment => $data->ac_comment,
     };
     bless ($self, $class);
     return $self;
@@ -75,7 +78,7 @@ sub create {
         die "unable to retrieve new ACL ID" unless defined $id;
 
         # Add to the history table.
-        my $date = DateTime->from_epoch (epoch => $time);
+        my $date = DateTime->from_epoch (epoch => $time, time_zone => $TZ);
         %record = (ah_acl    => $id,
                    ah_name   => $name,
                    ah_action => 'create',
@@ -126,6 +129,12 @@ sub name {
     return $self->{name};
 }
 
+# Returns the comment of the ACL.
+sub comment {
+    my ($self)= @_;
+    return $self->{comment};
+}
+
 # Given an ACL scheme, return the mapping to a class by querying the
 # database, or undef if no mapping exists.  Also load the relevant module.
 sub scheme_mapping {
@@ -161,7 +170,7 @@ sub log_acl {
     unless ($action =~ /^(add|remove|rename)\z/) {
         die "invalid history action $action";
     }
-    my $date = DateTime->from_epoch (epoch => $time);
+    my $date = DateTime->from_epoch (epoch => $time, time_zone => $TZ);
     my %record = (ah_acl        => $self->{id},
                   ah_name       => $self->{name},
                   ah_action     => $action,
@@ -294,7 +303,7 @@ sub destroy {
         $entry->delete if defined $entry;
 
         # Create new history line for the deletion.
-        my $date = DateTime->from_epoch (epoch => $time);
+        my $date = DateTime->from_epoch (epoch => $time, time_zone => $TZ);
         my %record = (ah_acl    => $self->{id},
                       ah_name   => $self->{name},
                       ah_action => 'destroy',
@@ -355,6 +364,49 @@ sub add {
     return 1;
 }
 
+# Get the comment of an ACL.
+sub get_comment {
+    my ($self) = @_;
+    return $self->comment();
+}
+
+# Set the comment of an ACL.
+sub set_comment {
+    my ($self, $comment) = @_;
+
+    if (defined($comment)) {
+        if ($comment eq q{}) {
+            $comment = undef;
+        } else {
+            if (length($comment) > 255) {
+                $self->error ('comment cannot be longer than 255 characters');
+                return;
+            }
+        }
+        eval {
+            my $guard = $self->{schema}->txn_scope_guard;
+            my %search = (ac_id => $self->{id});
+            my $acl = $self->{schema}->resultset('Acl')->find (\%search);
+            $acl->ac_comment($comment);
+            $acl->update;
+            $guard->commit;
+
+            # Re-read (comment field may have been truncated)
+            $acl = $self->{schema}->resultset('Acl')->find (\%search);
+            $self->{comment} = $acl->ac_comment;
+        };
+        if ($@) {
+            $self->error ("cannot update comment for ACL $self->{name}: $@");
+            return;
+        }
+    } else {
+        $self->error ("missing comment in set_comment for ACL $self->{name}");
+        return;
+    }
+
+    return 1;
+}
+
 # Remove an ACL entry to this ACL.  Returns true on success and false on
 # failure.  Detect the case where no such row exists before doing the delete
 # so that we can provide a good error message.
@@ -396,6 +448,7 @@ sub list {
     eval {
         my $guard = $self->{schema}->txn_scope_guard;
         my %search = (ae_id => $self->{id});
+        my %options = (order_by => { -asc => [qw/ah_on ah_id/] });
         my @entry_recs = $self->{schema}->resultset('AclEntry')
             ->search (\%search);
         for my $entry (@entry_recs) {
@@ -426,8 +479,18 @@ sub show {
     my $output = "Members of ACL $name (id: $id) are:\n";
     for my $entry (sort { $$a[0] cmp $$b[0] or $$a[1] cmp $$b[1] } @entries) {
         my ($scheme, $identifier) = @$entry;
-        $output .= "  $scheme $identifier\n";
+        if ($identifier) {
+            $output .= "  $scheme $identifier\n";
+        } else {
+            $output .= "  $scheme\n";
+        }
     }
+
+    my $comment = $self->comment;
+    if ($comment) {
+        $output .= "comment: $comment\n";
+    }
+
     return $output;
 }
 
@@ -438,16 +501,20 @@ sub history {
     eval {
         my $guard = $self->{schema}->txn_scope_guard;
         my %search  = (ah_acl => $self->{id});
-        my %options = (order_by => 'ah_on');
+        my %options = (order_by => { -asc => [qw/ah_on ah_id/] });
         my @data = $self->{schema}->resultset('AclHistory')
             ->search (\%search, \%options);
         for my $data (@data) {
             my $date = $data->ah_on;
             $date->set_time_zone ('local');
             $output .= sprintf ("%s %s  ", $date->ymd, $date->hms);
             if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') {
-                $output .= sprintf ("%s %s %s", $data->ah_action,
-                                    $data->ah_scheme, $data->ah_identifier);
+                if ($data->ah_identifier) {
+                    $output .= sprintf ("%s %s %s", $data->ah_action,
+                                        $data->ah_scheme, $data->ah_identifier);
+                } else {
+                    $output .= sprintf ("%s %s", $data->ah_action, $data->ah_scheme);
+                }
             } elsif ($data->ah_action eq 'rename') {
                 $output .= 'rename from ' . $data->ah_name;
             } else {

perl/lib/Wallet/Admin.pm

@@ -85,6 +85,13 @@ sub DESTROY {
 sub initialize {
     my ($self, $user) = @_;
 
+    # Suppress warnings that actually are just informational messages.
+    local $SIG{__WARN__} = sub {
+        my ($warn) = @_;
+        return if $warn =~ m{NOTICE:  table "\S+" does not exist, skipping};
+        warn $warn;
+    };
+
     # Deploy the database schema from DDL files, if they exist.  If not then
     # we automatically get the database from the Schema modules.
     $self->{schema}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY);
@@ -154,6 +161,14 @@ sub default_data {
 # false on failure.
 sub reinitialize {
     my ($self, $user) = @_;
+
+    # Suppress warnings that actually are just informational messages.
+    local $SIG{__WARN__} = sub {
+        my ($warn) = @_;
+        return if $warn =~ m{NOTICE:  table "\S+" does not exist, skipping};
+        warn $warn;
+    };
+
     return unless $self->destroy;
     return $self->initialize ($user);
 }
@@ -165,9 +180,9 @@ sub destroy {
 
     # Get an actual DBI handle and use it to delete all tables.
     my $dbh = $self->dbh;
-    my @tables = qw/acl_entries object_history objects acls acl_history
+    my @tables = qw/acl_entries duo object_history objects acls acl_history
       acl_schemes enctypes flags keytab_enctypes keytab_sync sync_targets
-      duo types dbix_class_schema_versions/;
+      types dbix_class_schema_versions/;
     for my $table (@tables) {
         my $sql = "DROP TABLE IF EXISTS $table";
         $dbh->do ($sql);
@@ -212,6 +227,7 @@ sub upgrade {
     # Perform the actual upgrade.
     if ($self->{schema}->get_db_version) {
         $self->{schema}->upgrade_directory ($Wallet::Config::DB_DDL_DIRECTORY);
+        #use Data::Dumper; warn Dumper $self->{schema};
         eval { $self->{schema}->upgrade; };
     }
     if ($@) {

perl/lib/Wallet/Object/Base.pm

@@ -24,6 +24,8 @@ use Wallet::ACL;
 
 our $VERSION = '1.04';
 
+my $TZ = DateTime::TimeZone->new( name => 'local' );
+
 ##############################################################################
 # Constructors
 ##############################################################################
@@ -60,7 +62,7 @@ sub create {
     die "invalid object name\n" unless $name;
     my $guard = $schema->txn_scope_guard;
     eval {
-        my $date = DateTime->from_epoch (epoch => $time);
+        my $date = DateTime->from_epoch (epoch => $time, time_zone => $TZ);
         my %record = (ob_type         => $type,
                       ob_name         => $name,
                       ob_created_by   => $user,
@@ -134,7 +136,7 @@ sub log_action {
     # assume that AutoCommit is turned off.
     my $guard = $self->{schema}->txn_scope_guard;
     eval {
-        my $date = DateTime->from_epoch (epoch => $time);
+        my $date = DateTime->from_epoch (epoch => $time, time_zone => $TZ);
         my %record = (oh_type   => $self->{type},
                       oh_name   => $self->{name},
                       oh_action => $action,
@@ -188,7 +190,7 @@ sub log_set {
         die "invalid history field $field";
     }
 
-    my $date = DateTime->from_epoch (epoch => $time);
+    my $date = DateTime->from_epoch (epoch => $time, time_zone => $TZ);
     my %record = (oh_type       => $self->{type},
                   oh_name       => $self->{name},
                   oh_action     => 'set',
@@ -353,7 +355,7 @@ sub expires {
             $self->error ("malformed expiration time $expires");
             return;
         }
-        my $date = DateTime->from_epoch (epoch => $seconds);
+        my $date = DateTime->from_epoch (epoch => $seconds, time_zone => $TZ);
         return $self->_set_internal ('expires', $date, $user, $host, $time);
     } elsif (defined $expires) {
         return $self->_set_internal ('expires', undef, $user, $host, $time);
@@ -743,7 +745,7 @@ sub destroy {
         $self->{schema}->resultset('Object')->search (\%search)->delete;
 
         # And create a new history object for the destroy action.
-        my $date = DateTime->from_epoch (epoch => $time);
+        my $date = DateTime->from_epoch (epoch => $time, time_zone => $TZ);
         my %record = (oh_type => $type,
                       oh_name => $name,
                       oh_action => 'destroy',

perl/lib/Wallet/Report.pm

@@ -504,15 +504,18 @@ sub acls_unused {
 }
 
 # Obtain a textual representation of the membership of an ACL, returning undef
-# on error and setting the internal error.
+# on error and setting the internal error. Make sure the membership is sorted
+# so that comparisons are possible.
 sub acl_membership {
     my ($self, $id) = @_;
     my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
     if ($@) {
         $self->error ($@);
         return;
     }
-    my @members = map { "$_->[0] $_->[1]" } $acl->list;
+    my @entries = $acl->list;
+    my @entries_sorted = sort { $$a[0] cmp $$b[0] or $$a[1] cmp $$b[1] } @entries;
+    my @members = map { "$_->[0] $_->[1]" } @entries_sorted;
     if (!@members && $acl->error) {
         $self->error ($acl->error);
         return;

perl/lib/Wallet/Schema.pm

@@ -20,7 +20,7 @@ use base 'DBIx::Class::Schema';
 # Unlike all of the other wallet modules, this module's version is tied to the
 # version of the schema in the database.  It should only be changed on schema
 # changes, at least until better handling of upgrades is available.
-our $VERSION = '0.10';
+our $VERSION = '0.11';
 
 __PACKAGE__->load_namespaces;
 __PACKAGE__->load_components (qw/Schema::Versioned/);
@@ -50,6 +50,7 @@ sub connect {
     my $user = $Wallet::Config::DB_USER;
     my $pass = $Wallet::Config::DB_PASSWORD;
     my %attrs = (PrintError => 0, RaiseError => 1);
+
     my $schema = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) };
     if ($@) {
         die "cannot connect to database: $@\n";

perl/lib/Wallet/Schema/Result/Acl.pm

@@ -42,13 +42,21 @@ __PACKAGE__->table("acls");
   is_nullable: 0
   size: 255
 
+=head2 ac_comment
+
+  data_type: 'varchar'
+  is_nullable: 1
+  size: 255
+
 =cut
 
 __PACKAGE__->add_columns(
   "ac_id",
   { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
   "ac_name",
   { data_type => "varchar", is_nullable => 0, size => 255 },
+  "ac_comment",
+  { data_type => "varchar", is_nullable => 1, size => 255 },
 );
 __PACKAGE__->set_primary_key("ac_id");
 __PACKAGE__->add_unique_constraint("ac_name", ["ac_name"]);

perl/lib/Wallet/Server.pm

@@ -633,6 +633,32 @@ sub acl_check {
     return 1;
 }
 
+# Retrieves or sets the comment of an ACL. We don't record comment changes
+# to the ACL history table.
+sub acl_comment {
+    my ($self, $id, $comment) = @_;
+    unless ($self->{admin}->check ($self->{user})) {
+        $self->acl_error ($id, 'comment');
+        return;
+    }
+    my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) };
+    if ($@) {
+        $self->error ($@);
+        return;
+    }
+
+    my $result;
+    if (defined $comment) {
+        $result = $acl->set_comment ($comment);
+    } else {
+        return $acl->get_comment();
+    }
+    if (not defined ($result) and $acl->error) {
+        $self->error ($acl->error);
+    }
+    return $result;
+}
+
 # Create a new empty ACL in the database.  Returns true on success and undef
 # on failure, setting the internal error.
 sub acl_create {

perl/sql/Wallet-Schema-0.10-0.11-MySQL.sql

@@ -0,0 +1,9 @@
+-- Convert schema 'sql/Wallet-Schema-0.10-MySQL.sql' to 'Wallet::Schema v0.11':;
+
+BEGIN;
+
+ALTER TABLE acls ADD COLUMN ac_comment varchar(255);
+
+COMMIT;
+
+

perl/sql/Wallet-Schema-0.10-0.11-PostgreSQL.sql

@@ -0,0 +1,8 @@
+-- Convert schema 'sql/Wallet-Schema-0.10-PostgreSQL.sql' to 'sql/Wallet-Schema-0.11-PostgreSQL.sql':;
+
+BEGIN;
+
+ALTER TABLE acls ADD COLUMN ac_comment character varying(255) NULL;
+
+COMMIT;
+

perl/sql/Wallet-Schema-0.10-0.11-SQLite.sql

@@ -0,0 +1,7 @@
+-- Convert schema 'sql/Wallet-Schema-0.10-SQLite.sql' to 'sql/Wallet-Schema-0.11-SQLite.sql':;
+
+BEGIN;
+
+ALTER TABLE acls ADD ac_comment varchar(255) default null;
+
+COMMIT;