Begin to collect packet handling into object-oriented classes
authorJacob Bachmeyer <jcb@gnu.org>
Tue, 20 Jun 2023 02:46:28 +0000 (21:46 -0500)
committerJacob Bachmeyer <jcb@gnu.org>
Tue, 20 Jun 2023 02:46:28 +0000 (21:46 -0500)
gatekeeper.pl

index ae3159d6c14caf7a4125c93b4209bf5c82d9ef6e..55ee1b7a0bd1fb58a01adc4c10adc223f9f65838 100755 (executable)
@@ -1611,6 +1611,57 @@ sub find_package {
 
 =back
 
+=head2 Packet model classes
+
+=over
+
+=item TODO
+
+=cut
+
+{
+  package Local::Packet;
+
+  # can be given an arrayref or a file list
+  sub collect {
+    my $class = shift;
+
+    my @files;
+    if (ref $_[0])     { @files = @{$_[0]} }
+    else               { @files = @_ }
+
+    (bless \@files, $class)->init
+  }
+
+  sub init { shift }
+
+  # scaffolding for now...
+  sub files { @{(shift)} }
+
+  sub has_uploaded_file { return 0 }
+}
+
+{
+  package Local::Packet::Directive;
+  {our @ISA = qw(Local::Packet)}
+
+  sub file_name_stem { substr((shift)->[0],0,-(length '.directive.asc')) }
+
+  sub directive_file_name { (shift)->[0] }
+
+}
+
+{
+  package Local::Packet::Directive::Upload;
+  {our @ISA = qw(Local::Packet::Directive)}
+
+  sub has_uploaded_file { return 1 }
+}
+
+\f
+
+=back
+
 =head2 [SC] Scan Inbox
 
 =over
@@ -1798,7 +1849,7 @@ sub gather_packets {
        }
       }
 
-      push @ret, $triplet;
+      push @ret, Local::Packet::Directive::Upload->collect($triplet);
       ftp_syslog info => 'processing ['.join(':',@$triplet).']';
     } else {
       # A lone directive file:  STEM.directive.asc
@@ -1836,7 +1887,7 @@ sub gather_packets {
                     "rename $directory/$file to $scratchpad/$file: $!";
          next STEM                     # abandon processing this item
        }
-       push @ret, [$file];
+       push @ret, Local::Packet::Directive->collect($file);
        ftp_syslog info => 'processing ['.$file.']';
       }
     }
@@ -2065,7 +2116,7 @@ sub validate_directive {
   my $packet = shift;
   my $ops = shift;
 
-  my $stem = substr $packet->[0],0,-(length '.directive.asc');
+  my $stem = $packet->file_name_stem;
   my $op_header = $ops->[0][1];
 
   # Configuration must exist for the package
@@ -2081,7 +2132,7 @@ sub validate_directive {
 
   # Check that we actually have at least one command in the directive
   unless ($#$ops > 0) {
-    if (1 == scalar @$packet) {
+    if (not $packet->has_uploaded_file) {
       throw directive_syntax =>
        trace => [], directory => $op_header->{directory},
        summary => 'nothing to do - no commands in directive file';
@@ -3090,8 +3141,8 @@ my @packets;
 }
 
 foreach my $packet (@packets) {        # each list element is an array reference
-  my $stem = substr $packet->[0],0,-(length '.directive.asc');
-  ftp_syslog info => "found directive: $packet->[0]";
+  my $stem = $packet->file_name_stem;
+  ftp_syslog info => 'found directive: '.$packet->directive_file_name;
 
   # variables preserved for the report if an exception is thrown
   my $directive_text; my $directive; my $oplist; my $op_header;
@@ -3101,12 +3152,12 @@ foreach my $packet (@packets) { # each list element is an array reference
   my $complete = 0;    # direct flag to indicate successful processing
 
   # scaffolding to be cleaned up as the internal API is improved
-  my $directive_only = (1 == scalar @$packet);
-  my $directive_file = $packet->[0];
+  my $directive_only = not $packet->has_uploaded_file;
+  my $directive_file = $packet->directive_file_name;
   my $upload_file = ''; my $sig_file = '';
 
   unless ($directive_only) {
-    foreach (@{$packet}[1..$#$packet]) {
+    foreach ($packet->files) {
       if (m/[.]sig$/) { $sig_file =$_ } else { $upload_file = $_ }
     }
   }
@@ -3115,13 +3166,14 @@ foreach my $packet (@packets) { # each list element is an array reference
     local $Phase = 'PS';
 
     $directive_text = slurp_clearsigned_message
-      (File::Spec->catfile(CONF_DIR_Scratch, $packet->[0]));
+      (File::Spec->catfile(CONF_DIR_Scratch, $packet->directive_file_name));
 
     # This would imply that the directive file did not contain a signed
     # message.  There is nothing further to do.
     throw directive_syntax => trace => [], directory => undef,
-      summary => "directive file $packet->[0] has no signature"
-       if $directive_text eq '';
+      summary =>
+       'directive file '.$packet->directive_file_name.' has no signature'
+         if $directive_text eq '';
 
     $directive = read_directive_from_string($directive_text);