aboutsummaryrefslogtreecommitdiff
path: root/perl/lib/Wallet/Report.pm
blob: 3d59bf8d33ca446ef8d9f3a0dad49ffc8a65a018 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
# Wallet::Report -- Wallet system reporting interface
#
# Written by Russ Allbery <eagle@eyrie.org>
# Copyright 2016 Russ Allbery <eagle@eyrie.org>
# Copyright 2008, 2009, 2010, 2013, 2014
#     The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.

##############################################################################
# Modules and declarations
##############################################################################

package Wallet::Report;

use 5.008;
use strict;
use warnings;

use Wallet::ACL;
use Wallet::Schema;

our $VERSION = '1.03';

##############################################################################
# Constructor, destructor, and accessors
##############################################################################

# Create a new wallet report object.  Opens a connection to the database that
# will be used for all of the wallet configuration information.  Throw an
# exception if anything goes wrong.
sub new {
    my ($class) = @_;
    my $schema = Wallet::Schema->connect;
    my $self = { schema => $schema };
    bless ($self, $class);
    return $self;
}

# Returns the database handle (used mostly for testing).
sub dbh {
    my ($self) = @_;
    return $self->{schema}->storage->dbh;
}

# Returns the DBIx::Class-based database schema object.
sub schema {
    my ($self) = @_;
    return $self->{schema};
}

# Set or return the error stashed in the object.
sub error {
    my ($self, @error) = @_;
    if (@error) {
        my $error = join ('', @error);
        chomp $error;
        1 while ($error =~ s/ at \S+ line \d+\.?\z//);
        $self->{error} = $error;
    }
    return $self->{error};
}

# Disconnect the database handle on object destruction to avoid warnings.
sub DESTROY {
    my ($self) = @_;
    $self->{schema}->storage->dbh->disconnect;
}

##############################################################################
# Object reports
##############################################################################

# Return the SQL statement to find every object in the database.
sub objects_all {
    my ($self) = @_;
    my @objects;

    my %search = ();
    my %options = (order_by => [ qw/ob_type ob_name/ ],
                   select   => [ qw/ob_type ob_name/ ]);

    return (\%search, \%options);
}

# Return the SQL statement and the search field required to find all objects
# matching a specific type.
sub objects_type {
    my ($self, $type) = @_;
    my @objects;

    my %search = (ob_type => $type);
    my %options = (order_by => [ qw/ob_type ob_name/ ],
                   select   => [ qw/ob_type ob_name/ ]);

    return (\%search, \%options);
}

# Return the SQL statement and search field required to find all objects owned
# by a given ACL.  If the requested owner is null, we ignore this and do a
# different search for IS NULL.  If the requested owner does not actually
# match any ACLs, set an error and return undef.
sub objects_owner {
    my ($self, $owner) = @_;
    my @objects;

    my %search;
    my %options = (order_by => [ qw/ob_type ob_name/ ],
                   select   => [ qw/ob_type ob_name/ ]);

    if (lc ($owner) eq 'null') {
        %search = (ob_owner => undef);
    } else {
        my $acl = eval { Wallet::ACL->new ($owner, $self->{schema}) };
        return unless $acl;
        %search = (ob_owner => $acl->id);
    }

    return (\%search, \%options);
}

# Return the SQL statement and search field required to find all objects that
# have a specific flag set.
sub objects_flag {
    my ($self, $flag) = @_;
    my @objects;

    my %search = ('flags.fl_flag' => $flag);
    my %options = (join     => 'flags',
                   prefetch => 'flags',
                   order_by => [ qw/ob_type ob_name/ ],
                   select   => [ qw/ob_type ob_name/ ]);

    return (\%search, \%options);
}

# Return the SQL statement and search field required to find all objects that
# a given ACL has any permissions on.  This expands from objects_owner in that
# it will also match any records that have the ACL set for get, store, show,
# destroy, or flags.  If the requested owner does not actually match any ACLs,
# set an error and return the empty string.
sub objects_acl {
    my ($self, $search) = @_;
    my @objects;

    my $schema = $self->{schema};
    my $acl = eval { Wallet::ACL->new ($search, $schema) };
    return unless $acl;

    my @search = ({ ob_owner       => $acl->id },
                  { ob_acl_get     => $acl->id },
                  { ob_acl_store   => $acl->id },
                  { ob_acl_show    => $acl->id },
                  { ob_acl_destroy => $acl->id },
                  { ob_acl_flags   => $acl->id });
    my %options = (order_by => [ qw/ob_type ob_name/ ],
                   select   => [ qw/ob_type ob_name/ ]);

    return (\@search, \%options);
}

# Return the SQL statement to find all objects that have been created but
# have never been retrieved (via get).
sub objects_unused {
    my ($self) = @_;
    my @objects;

    my %search = (ob_downloaded_on => undef);
    my %options = (order_by => [ qw/ob_type ob_name/ ],
                   select   => [ qw/ob_type ob_name/ ]);

    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
# 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 {
    my ($self, $type, @args) = @_;
    undef $self->{error};

    # Get the search and options array refs from specific functions.
    my ($search_ref, $options_ref);
    if (!defined $type || $type eq '') {
        ($search_ref, $options_ref) = $self->objects_all;
    } else {
        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);
        } elsif ($type eq 'owner') {
            ($search_ref, $options_ref) = $self->objects_owner (@args);
        } elsif ($type eq 'flag') {
            ($search_ref, $options_ref) = $self->objects_flag (@args);
        } elsif ($type eq 'acl') {
            ($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");
        }
        return unless $search_ref;
    }

    # Perform the search and return on any errors.
    my @objects;
    my $schema = $self->{schema};
    eval {
        my @objects_rs = $schema->resultset('Object')->search ($search_ref,
                                                               $options_ref);
        for my $object_rs (@objects_rs) {
            push (@objects, [ $object_rs->ob_type, $object_rs->ob_name ]);
        }
    };
    if ($@) {
        $self->error ("cannot list objects: $@");
        return;
    }

    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 array of all ACLs in the database.
sub acls_all {
    my ($self) = @_;
    my @acls;

    my $schema = $self->{schema};
    my %search = ();
    my %options = (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 empty ACLs in the database.
sub acls_empty {
    my ($self) = @_;
    my @acls;

    my $schema = $self->{schema};
    my %search = (ae_id => undef);
    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 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;

    my $schema = $self->{schema};
    my %search = (ae_scheme     => $type,
                  ae_identifier => { like => '%'.$identifier.'%' });
    my %options = (join     => 'acl_entries',
                   prefetch => 'acl_entries',
                   order_by => [ qw/ac_id/ ],
                   select   => [ qw/ac_id ac_name/ ],
                   distinct => 1);

    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 unused ACLs.
sub acls_unused {
    my ($self) = @_;
    my @acls;

    my $schema = $self->{schema};
    my %search = (
                  #'acls_owner.ob_owner'   => undef,
                  #'acls_get.ob_owner'     => undef,
                  #'acls_store.ob_owner'   => undef,
                  #'acls_show.ob_owner'    => undef,
                  #'acls_destroy.ob_owner' => undef,
                  #'acls_flags.ob_owner'   => undef,
                 );
    my %options = (#join     => [ qw/acls_owner acls_get acls_store acls_show acls_destroy acls_flags/ ],
                   order_by => [ qw/ac_id/ ],
                   select   => [ qw/ac_id ac_name/ ]);

    eval {
        my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options);

        # FIXME: Almost certainly a way of doing this with the search itself.
        for my $acl_rs (@acls_rs) {
            next if $acl_rs->acls_owner->first;
            next if $acl_rs->acls_get->first;
            next if $acl_rs->acls_store->first;
            next if $acl_rs->acls_show->first;
            next if $acl_rs->acls_destroy->first;
            next if $acl_rs->acls_flags->first;
            push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]);
        }
    };

    if ($@) {
        $self->error ("cannot list ACLs: $@");
        return;
    }
    return (@acls);
}

# Obtain a textual representation of the membership of an ACL, returning undef
# on error and setting the internal error.
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;
    if (!@members && $acl->error) {
        $self->error ($acl->error);
        return;
    }
    return join ("\n", @members);
}

# Duplicate ACL detection unfortunately needs to do something more complex
# than just return a SQL statement, so it's handled differently than other
# reports.  All the work is done here and the results returned as a list of
# sets of duplicates.
sub acls_duplicate {
    my ($self) = @_;
    my @acls = sort map { $_->[1] } $self->acls;
    return if (!@acls && $self->{error});
    return if @acls < 2;
    my %result;
    for my $i (0 .. ($#acls - 1)) {
        my $members = $self->acl_membership ($acls[$i]);
        return unless defined $members;
        for my $j (($i + 1) .. $#acls) {
            my $check = $self->acl_membership ($acls[$j]);
            return unless defined $check;
            if ($check eq $members) {
                $result{$acls[$i]} ||= [];
                push (@{ $result{$acls[$i]} }, $acls[$j]);
            }
        }
    }
    my @result;
    for my $acl (sort keys %result) {
        push (@result, [ $acl, sort @{ $result{$acl} } ]);
    }
    return @result;
}

# Returns a list of all ACLs stored in the wallet database as a list of pairs
# of ACL IDs and ACL names, possibly limited by some criteria.  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.
sub acls {
    my ($self, $type, @args) = @_;
    undef $self->{error};

    # Find the ACLs for any given search.
    my @acls;
    if (!defined $type || $type eq '') {
        @acls = $self->acls_all;
    } else {
        if ($type eq 'duplicate') {
            return $self->acls_duplicate;
        } elsif ($type eq 'entry') {
            if (@args == 0) {
                $self->error ('ACL searches require an argument to search');
                return;
            } else {
                @acls = $self->acls_entry (@args);
            }
        } elsif ($type eq 'empty') {
            @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;
        }
    }
    return @acls;
}

# Returns all ACL entries contained in owner ACLs for matching objects.
# Objects are specified by type and name, which may be SQL wildcard
# expressions.  Each list member will be a pair of ACL scheme and ACL
# identifier, with duplicates removed.  On error and for no matching entries,
# the empty list will be returned.  To distinguish between an empty return and
# an error, call error(), which will return undef if there was no error.
sub owners {
    my ($self, $type, $name) = @_;
    undef $self->{error};
    my $schema = $self->{schema};

    my @owners;
    eval {
        my %search = (
                      'acls_owner.ob_type' => { like => $type },
                      'acls_owner.ob_name' => { like => $name });
        my %options = (
                       join     => { 'acls' => 'acls_owner' },
                       order_by => [ qw/ae_scheme ae_identifier/ ],
                       distinct => 1,
                      );

        my @acls_rs = $schema->resultset('AclEntry')->search (\%search,
                                                              \%options);
        for my $acl_rs (@acls_rs) {
            my $scheme = $acl_rs->ae_scheme;
            my $identifier = $acl_rs->ae_identifier;
            push (@owners, [ $scheme, $identifier ]);
        }
    };
    if ($@) {
        $self->error ("cannot report on owners: $@");
        return;
    }
    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
##############################################################################

# Audit the database for violations of local policy.  Returns a list of
# objects (as type and name pairs) or a list of ACLs (as ID and name pairs).
# On error and for no matching entries, the empty list will be returned.  To
# distinguish between an empty return and an error, call error(), which will
# return undef if there was no error.
sub audit {
    my ($self, $type, $audit) = @_;
    undef $self->{error};
    unless (defined ($type) and defined ($audit)) {
        $self->error ("type and audit not specified");
        return;
    }
    if ($type eq 'objects') {
        if ($audit eq 'name') {
            return unless defined &Wallet::Config::verify_name;
            my @objects = $self->objects;
            my @results;
            for my $object (@objects) {
                my ($type, $name) = @$object;
                my $error = Wallet::Config::verify_name ($type, $name);
                push (@results, $object) if $error;
            }
            return @results;
        } else {
            $self->error ("unknown object audit: $audit");
            return;
        }
    } elsif ($type eq 'acls') {
        if ($audit eq 'name') {
            return unless defined &Wallet::Config::verify_acl_name;
            my @acls = $self->acls;
            my @results;
            for my $acl (@acls) {
                my $error = Wallet::Config::verify_acl_name ($acl->[1]);
                push (@results, $acl) if $error;
            }
            return @results;
        } else {
            $self->error ("unknown acl audit: $audit");
            return;
        }
    } else {
        $self->error ("unknown audit type: $type");
        return;
    }
}

1;
__DATA__

##############################################################################
# Documentation
##############################################################################

=head1 NAME

Wallet::Report - Wallet system reporting interface

=for stopwords
ACL ACLs wildcard Allbery SQL tuples

=head1 SYNOPSIS

    use Wallet::Report;
    my $report = Wallet::Report->new;
    my @objects = $report->objects ('type', 'keytab');
    for my $object (@objects) {
        print "@$object\n";
    }
    @objects = $report->audit ('objects', 'name');

=head1 DESCRIPTION

Wallet::Report provides a mechanism to generate lists and reports on the
contents of the wallet database.  The format of the results returned
depend on the type of search, but will generally be returned as a list of
tuples identifying objects, ACLs, or ACL entries.

To use this object, several configuration variables must be set (at least
the database configuration).  For information on those variables and how
to set them, see L<Wallet::Config>.  For more information on the normal
user interface to the wallet server, see L<Wallet::Server>.

=head1 CLASS METHODS

=over 4

=item new()

Creates a new wallet report object and connects to the database.  On any
error, this method throws an exception.

=back

=head1 INSTANCE METHODS

For all methods that can fail, the caller should call error() after a
failure to get the error message.  For all methods that return lists, if
they return an empty list, the caller should call error() to distinguish
between an empty report and an error.

=over 4

=item acls([ TYPE [, SEARCH ... ]])

Returns a list of all ACLs matching a search type and string in the
database, or all ACLs if no search information is given.  There are
currently four search types.  C<duplicate> returns sets of duplicate ACLs
(ones with exactly the same entries).  C<empty> takes no arguments and
will return only those ACLs that have no entries within them.  C<entry>
takes two arguments, an entry scheme and a (possibly partial) entry
identifier, and will return any ACLs containing an entry with that scheme
and with an identifier containing that value.  C<unused> returns all ACLs
that are not referenced by any object.

The return value for everything except C<duplicate> is a list of
references to pairs of ACL ID and name.  For example, if there are two
ACLs in the database, one with name C<ADMIN> and ID 1 and one with name
C<group/admins> and ID 3, acls() with no arguments would return:

    ([ 1, 'ADMIN' ], [ 3, 'group/admins' ])

The return value for the C<duplicate> search is sets of ACL names that are
duplicates (have the same entries).  For example, if C<d1>, C<d2>, and
C<d3> are all duplicates, and C<o1> and C<o2> are also duplicates, the
result would be:

    ([ 'd1', 'd2', 'd3' ], [ 'o1', 'o2' ])

Returns the empty list on failure.  An error can be distinguished from
empty search results by calling error().  error() is guaranteed to return
the error message if there was an error and undef if there was no error.

=item audit(TYPE, AUDIT)

Audits the wallet database for violations of local policy.  TYPE is the
general class of thing to audit, and AUDIT is the specific audit to
perform.  TYPE may be either C<objects> or C<acls>.  Currently, the only
implemented audit is C<name>.  This returns a list of all objects, as
references to pairs of type and name, or ACLs, as references to pairs of
ID and name, that are not accepted by the verify_name() or
verify_acl_name() function defined in the wallet configuration.  See
L<Wallet::Config> for more information.

Returns the empty list on failure.  An error can be distinguished from
empty search results by calling error().  error() is guaranteed to return
the error message if there was an error and undef if there was no error.

=item 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.

=item objects([ TYPE [, SEARCH ... ]])

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 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>
and with values C<host/example.com> and C<foo>, objects() with no
arguments would return:

    ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ])

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 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
matching TYPE and NAME, which are interpreted as SQL patterns using C<%>
as a wildcard.  The return value is a list of references to pairs of
schema and identifier, with duplicates removed.

Returns the empty list on failure.  To distinguish between this and no
matches, 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.

=back

=head1 SEE ALSO

Wallet::Config(3), Wallet::Server(3)

This module is part of the wallet system.  The current version is
available from L<http://www.eyrie.org/~eagle/software/wallet/>.

=head1 AUTHOR

Russ Allbery <eagle@eyrie.org> and Jon Robertson <jonrober@stanford.edu>.

=cut