Merge pull request #605 from wtsi-npg/devel

pull from devel to master to create release 91.11.0
wtsi-npg · Mar 10, 2021 · 29fcb71 · 29fcb71
2 parents 246120f + f8a42a7
commit 29fcb71
Show file tree

Hide file tree

Showing 14 changed files with 168 additions and 122 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,13 @@
 LIST OF CHANGES
 
+release 91.11.0
+ - a partial reimplementation of the serialization framework for components
+   and compositions in order to speed-up frequently used methods 
+ - add geno files to disabled access list in http_sfweb.conf
+ - cookie decryption - use an up-to-date Crypt::CBC API and algorithm
+ - reduce the sleep type of the status daemon from 60 to 1 sec in order to
+   reduce the time it takes to loop over the run folders on lustre 
+
 release 91.10.0
  - script npg_samplesheet4MiSeq is removed this utility has been moved
    to a different git package; the samplesheet daemon stays in this

diff --git a/lib/npg/authentication/sanger_sso.pm b/lib/npg/authentication/sanger_sso.pm
@@ -1,6 +1,3 @@
-# Author:        [email protected]
-# Created:       2010-04-28
-
 package npg::authentication::sanger_sso;
 
 use strict;
@@ -33,11 +30,10 @@ sub sanger_username {
     $unescaped =~ s/\ /+/mxg;
     ##use critic
     my $decoded = decode_base64($unescaped);
-    my $crypt = Crypt::CBC->new(  -key         => $enc_key,
-                                  -literal_key => 1,
-                                  -cipher      => 'Blowfish',
-                                  -header      => 'randomiv',
-                                  -padding     => 'space');
+    my $crypt = Crypt::CBC->new(-pass    => $enc_key,
+                                -pbkdf   => 'pbkdf2',
+                                -cipher  => 'Blowfish',
+                                -padding => 'space');
     my $decrypted = $crypt->decrypt($decoded);
     ($username, $at_domain) = $decrypted =~ /<<<<(\w+)(@[\w|\.]+)?/xms;
     if ($username && $at_domain) {
@@ -60,7 +56,7 @@ __END__
 
 =head1 DESCRIPTION
 
-Module to extract username from WTSI single sign-on cookie value
+Module to extract username from WSI single sign-on cookie value
 
 =head1 SUBROUTINES/METHODS
 
@@ -90,7 +86,7 @@ Called by Catalyst authentication infrastructure....
 
 =item Readonly
 
-=item Exporter qw(import)
+=item Exporter
 
 =back
 
@@ -100,11 +96,17 @@ Called by Catalyst authentication infrastructure....
 
 =head1 AUTHOR
 
-David Jackson
+=over
+
+=item David Jackson
 
+=item Jennifer Liddle
+
+=back
+ 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (C) 2012 GRL, by Jennifer Liddle ([email protected])
+Copyright (C) 2012,2013,2014,2021 Genome Research Ltd.
 
 This program is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by

diff --git a/lib/npg_tracking/glossary/composition.pm b/lib/npg_tracking/glossary/composition.pm
@@ -7,7 +7,7 @@ use MooseX::StrictConstructor;
 use List::MoreUtils qw/ bsearch/;
 use Carp;
 
-with Storage( 'traits' => ['OnlyWhenBuilt'],
+with Storage( 'traits' => [qw/OnlyWhenBuilt DisableCycleDetection/],
               'format' => '=npg_tracking::glossary::composition::serializable' );
 
 our $VERSION = '0';

diff --git a/lib/npg_tracking/glossary/composition/component.pm b/lib/npg_tracking/glossary/composition/component.pm
@@ -1,10 +1,11 @@
 package npg_tracking::glossary::composition::component;
 
 use Moose::Role;
+use namespace::autoclean;
 use MooseX::Storage;
 use Carp;
 
-with Storage( 'traits' => ['OnlyWhenBuilt'],
+with Storage( 'traits' => [qw/OnlyWhenBuilt DisableCycleDetection/],
               'format' => '=npg_tracking::glossary::composition::serializable' );
 
 our $VERSION = '0';
@@ -79,6 +80,8 @@ See digest() in npg_tracking::glossary::composition::serializable.
 
 =item MooseX::Storage
 
+=item namespace::autoclean
+
 =item Carp
 
 =back
@@ -93,7 +96,7 @@ Marina Gourtovaia E<lt>[email protected]<gt>
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (C) 2015 GRL
+Copyright (C) 2015,2021 Genome Research Ltd.
 
 This file is part of NPG.
 

diff --git a/lib/npg_tracking/glossary/composition/serializable.pm b/lib/npg_tracking/glossary/composition/serializable.pm
@@ -8,6 +8,7 @@ use Digest::MD5 qw/md5_hex/;
 use Carp;
 use Readonly;
 use Class::Load qw/load_class/;
+use List::MoreUtils qw/uniq/;
 
 use npg_tracking::glossary::rpt;
 
@@ -25,35 +26,29 @@ Readonly::Scalar my $CLASS_NAME_KEY          => '__CLASS__';
 sub thaw {
   my ( $class, $json, @args ) = @_;
 
-  if (!$json) {
-    croak 'JSON string is required';
-  }
-
   my $h = JSON::XS->new()->decode($json);
 
   my $component_class;
   my $enforce_component_class = 0;
   if (@args && scalar @args % 2 == 0) {
     my %ah = @args;
-    $component_class         = $ah{$COMPONENT_CLASS};
-    $enforce_component_class = $ah{$ENFORCE_COMPONENT_CLASS};
-    if ($component_class) {
-      delete $ah{$COMPONENT_CLASS};
-      delete $ah{$ENFORCE_COMPONENT_CLASS};
-      @args = %ah;
+    $component_class = delete $ah{$COMPONENT_CLASS};
+    my $tmp          = delete $ah{$ENFORCE_COMPONENT_CLASS};
+    if (defined $tmp) {
+      $enforce_component_class = $tmp;
     }
+    @args = %ah;
   }
 
   #####
   # JSON string is a serialized composition or component object.
   #
-  foreach my $component_h ( $h->{$COMPONENTS_ATTR_NAME} ? @{$h->{$COMPONENTS_ATTR_NAME}} : () ) {
-    my $cclass = $component_h->{$CLASS_NAME_KEY};
-    if ($cclass) {
-      if ($component_class && $enforce_component_class
-            && ($component_class ne $cclass)) {
-        croak "Unexpected component class $cclass";
-      }
+  if ( $h->{$COMPONENTS_ATTR_NAME} ) {
+    my @classes = ();
+    foreach my $component_h ( @{$h->{$COMPONENTS_ATTR_NAME}} ) {
+
+      my $cclass = $component_h->{$CLASS_NAME_KEY};
+      $cclass ||= q();
       #####
       # The class name might be concatenated with package version.
       # A dash is used for concatenation. No way to know whether
@@ -62,23 +57,31 @@ sub thaw {
       # name.
       #
       ($cclass) = split /-/smx, $cclass;
-    } elsif ($component_class) {
-      $cclass = $component_class;
-    } else {
-      croak "Component class unknown, try defining via $COMPONENT_CLASS option";
+
+      if ($cclass) {
+        if ($component_class && $enforce_component_class
+            && ($component_class ne $cclass)) {
+          croak "Unexpected component class $cclass";
+        }
+      } elsif ($component_class) {
+        $cclass = $component_class;
+      } else {
+        croak "Component class unknown, try defining via $COMPONENT_CLASS option";
+      }
+      $component_h->{$CLASS_NAME_KEY} = $cclass;
+      push @classes, $cclass;
+    }
+    for my $class_name (uniq @classes) {
+      load_class $class_name;
     }
-    $component_h->{$CLASS_NAME_KEY} = $cclass;
-    load_class $cclass; # Multiple attempts to load the same class are OK
   }
 
   return $class->unpack( $h, @args );
 }
 
 sub freeze {
   my ($self, @args) = @_;
-  if ( $self->can('sort') ) {
-    $self->sort();
-  }
+
   if (@args && (@args != 2 || $args[0] ne $FREEZE_WITH_CLASS_NAMES)) {
     croak "Options not recognised, allowed option - $FREEZE_WITH_CLASS_NAMES";
   }
@@ -88,17 +91,10 @@ sub freeze {
 
 sub freeze2rpt {
   my $self = shift;
-
-  my $values = $self->_pack_custom();
-  my $rpt_string;
-  if ($values->{$COMPONENTS_ATTR_NAME}) {
-    $rpt_string = npg_tracking::glossary::rpt
-                    ->deflate_rpts($values->{$COMPONENTS_ATTR_NAME});
-  } else {
-    $rpt_string = npg_tracking::glossary::rpt->deflate_rpt($values);
-  }
-
-  return $rpt_string;
+  my @rpts = map { npg_tracking::glossary::rpt->deflate_rpt($_) }
+             (ref $self eq 'npg_tracking::glossary::composition') ?
+             $self->components_list() : ($self);
+  return npg_tracking::glossary::rpt->join_rpts(@rpts);
 }
 
 sub digest {
@@ -117,28 +113,23 @@ sub _pack_custom {
   return _clean_pack($self->pack());
 }
 
-sub _clean_pack { # Recursive function
+sub _clean_pack {
   my $old = shift;
 
-  my $type = ref $old;
-  if (!$type || $type ne 'HASH') {
-    return $old;
-  }
-
-  my $values = {};
-  while ( my ($k, $v) = each %{$old} ) {
-     # Delete __CLASS__ key along with private attrs
-    if (defined $v && $k !~ /\A_/smx) {
-      # Treat components the same way
-      if (ref $v eq 'ARRAY' && $k eq $COMPONENTS_ATTR_NAME) {
-        my @clean = map { _clean_pack($_) } @{$v};
-        $v = \@clean;
-      }
-      $values->{$k} = $v;
-    }
+  # Do not pack the __CLASS__ key and other private attributes.
+  # Do not pack undefined attributes.
+  # Recurse for components.
+  my %packed = map  { $_ => $old->{$_} }
+               grep { defined $old->{$_} }
+               grep { not m{\A _}smx }
+               keys %{$old};
+  if (exists $packed{$COMPONENTS_ATTR_NAME}) {
+    $packed{$COMPONENTS_ATTR_NAME} = [
+      (map { _clean_pack($_) } @{$packed{$COMPONENTS_ATTR_NAME}})
+                                     ];
   }
 
-  return $values;
+  return \%packed;
 }
 
 no Moose::Role;
@@ -182,13 +173,53 @@ npg_tracking::glossary::composition::serializable
 
 =head1 DESCRIPTION
 
-Custom JSON serialization format for MooseX::Storage framework.
-Differences with MooseX::Storage::Format::JSON:
-  - uses JSON::XS directly,
-  - private attributes are not serialized,
-  - the output does not contain the __CLASS__ key,
-  - the above applies recursively to an array reference attribute called
-    'components'.
+L<npg_tracking::glossary::composition> objects and component objects
+that make up a composition use the L<MooseX::Storage> serialization
+framework to enable serialization to (freeze) and from (thaw) JSON
+strings. This Moose role provides custom JSON serialization format
+for MooseX::Storage framework by implementing custom C<freeze> and
+C<thaw> methods. The role also provides other custom serialization
+formats, which are used by NPG pipelines and other applications.
+
+=head2 Serialization to JSON
+
+Differences with L<MooseX::Storage::Format::JSON>:
+
+=over
+
+=item Uses JSON::XS.
+
+=item Produces canonical (sorted) JSON strings.
+
+=item Private attributes are not serialized.
+
+=item The C<__CLASS__> key is not serialized.
+
+=item The above applies recursively to members of an array reference
+      attribute called C<components>, which can contain objects of any
+      class as long as these classes consume the
+      L<npg_tracking::glossary::composition::component> role.
+
+=back
+
+=head2 Serialization to an rtp string.
+
+A lossy conversion to a concise text string, which can be used as a
+convenient human-readable id in web applications and command line arguments.
+This type of serialization is specific to the
+L<npg_tracking::glossary::composition::component::illumina> class. It
+disregards the value of the C<subset> attribute of the object. See
+L<npg_tracking::glossary::rpt> for details.
+
+=head2 Serialization to unique 64- or 32-long character strings
+
+This is a one-way serialization that is possible for any type of the
+component. It produces fixed length strings that are unique to a particular
+component or composition object and are guaranteed not to clash. The
+computation of the string is deterministic. These strings are widely used
+in NPG applications as unique identifiers for pipelines' inputs and outputs
+and as the common part of files names in cases of complex provenance of
+the files, see L<npg_tracking::glossary::moniker> for details.
 
 =head1 SUBROUTINES/METHODS
 
@@ -282,6 +313,8 @@ Returns a digest of an input string.
 
 =item Readonly
 
+=item List::MoreUtils
+
 =item npg_tracking::glossary::rpt
 
 =back
@@ -296,7 +329,7 @@ Marina Gourtovaia E<lt>[email protected]<gt>
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (C) 2016 GRL
+Copyright (C) 2015,2016,2018,2021 Genome Research Ltd.
 
 This file is part of NPG.