Merge pull request #110 from wtsi-npg/devel

merge devel to master, preparation for release 2.6.1

.travis.yml

@@ -1,7 +1,9 @@
 language: perl
+sudo: required
 
 perl:
   - "5.16"
+  - "5.22-shrplib"
 
 addons:
   postgresql: "9.3"
@@ -11,14 +13,14 @@ env:
     - secure: ZYRGAGHl/9mtiuNtSPhRR34RAqQTX5qMthUO07dytNtle7EPJ+K9tNwT6RvTL6qsNxE0gtvNiAGIZP8aKo/wzEdHKMeJT7E3HaVw/7OQpd/qHegxJlLrkTbo1DlZISM0UgM1u6505ioxzKFed+YaPq+EveHT5V713qkH626GUOw=
     - PGVERSION="9.3"
     - JANSSON_VERSION="2.7"
-    - BATON_VERSION="0.16.4"
-    - DISPOSABLE_IRODS_VERSION="1.1"
+    - BATON_VERSION="0.17.1"
+    - DISPOSABLE_IRODS_VERSION="1.2"
     - RENCI_FTP_URL=ftp://ftp.renci.org
     - WTSI_NPG_GITHUB_URL=https://github.com/wtsi-npg
 
   matrix:
     - IRODS_VERSION=3.3.1 IRODS_RIP_DIR=/usr/local/irods
-    - IRODS_VERSION=4.1.9 PG_PLUGIN_VERSION=1.9 PLATFORM=ubuntu12
+    - IRODS_VERSION=4.1.10 PG_PLUGIN_VERSION=1.10 PLATFORM=ubuntu12
 
 before_install:
   - ./scripts/travis_before_install.sh
@@ -33,7 +35,6 @@ script:
   - ilsresc -l
   - ./scripts/travis_script.sh
 
-
 after_success:
   - ./Build dist
   - export DIST_FILE=$(ls WTSI-NPG-iRODS-*.tar.gz)

Build.PL

@@ -19,6 +19,7 @@ my $build = WTSI::DNAP::Utilities::Build->new
                           'Module::Build'             => '>= 0.42'
                          },
    build_requires      => {
+                          'File::Copy::Recursive'     => '>= 0.38',
                           'Test::Perl::Critic'        => '0',
                           'TAP::Harness'              => '>= 3.30',
                           'Test::Class'               => '>= 0.41',
@@ -43,10 +44,11 @@ my $build = WTSI::DNAP::Utilities::Build->new
                           'Set::Scalar'               => '>= 1.29',
                           'Try::Tiny'                 => '>= 0.22',
                           'URI'                       => '>= 1.67',
-                          'WTSI::DNAP::Utilities'     => '>= 0.5.2'
+                          'WTSI::DNAP::Utilities'     => '>= 0.5.2',
                          },
    recommends =>         {
-                          'Net::LDAP'                 => '0'
+                          'Net::LDAP'                     => '0',
+                          'WTSI::DNAP::Warehouse::Schema' => '0',
                          });
 
 $build->create_build_script;

Changes

@@ -1,3 +1,6 @@
+Release 2.6.1
+ - Support baton versions  >=0.16.4 and <=0.17.1
+
 Release 2.6.0
 
  - Bugfix; correctly report multiple AVUs found for a given attribute

README

@@ -24,4 +24,4 @@ iRODS   https://github.com/irods/irods-legacy
 
 baton   https://github.com/wtsi-npg/baton
 
-        Version 0.16.4 - 0.17.0
+        Version 0.16.4 - 0.17.1

bin/populate_wtsi_irods_groups.pl

@@ -8,11 +8,11 @@
 use autodie;
 use Getopt::Long;
 use List::MoreUtils qw(uniq);
-use Log::Log4perl;
-use Log::Log4perl::Level;
+use Log::Log4perl qw(:levels);
+use Net::LDAP;
 use Readonly;
 
-use npg_warehouse::Schema;
+use WTSI::DNAP::Warehouse::Schema;
 use WTSI::NPG::iRODS::GroupAdmin;
 
 our $VERSION = '';
@@ -51,39 +51,28 @@
   --debug       Enable debug level logging. Optional, defaults to false.
   --dry-run     Report proposed changes, do not perform them. Optional.
   --dry_run
-  --group-min   Minumum number of "getent group" records to expect [200]
-  --group_min
   --help        Display help.
   --logconf     A log4perl configuration file. Optional.
-  --passwd-min  Minumum number of "getent passwd" records to expect [5000]
-  --passwd_min
-  --study       Restrict updates to a study. May be used multiple times
-                to select more than one study. Optional.
+  --study       Restrict updates to a study identifier. May be used multiple
+                times to select more than one study. Optional.
   --verbose     Print messages while processing. Optional.
 
 WOE
 
-Readonly::Scalar my $GETENT_GROUP_ALERT_THRESH  => 200;
-Readonly::Scalar my $GETENT_PASSWD_ALERT_THRESH => 5000;
-
 my $debug;
 my $dry_run;
-my $group_min_record_count = $GETENT_GROUP_ALERT_THRESH;
 my $log4perl_config;
-my $passwd_min_record_count = $GETENT_PASSWD_ALERT_THRESH;
 my $verbose;
-my @studies;
+my @study_ids;
 
 GetOptions('debug'                   => \$debug,
            'dry-run|dry_run'         => \$dry_run,
-           'group-min|group_min=i'   => \$group_min_record_count,
            'help'                    => sub {
              print $what_on_earth;
              exit 0;
            },
            'logconf=s'               => \$log4perl_config,
-           'passwd-min|passwd_min=i' => \$passwd_min_record_count,
-           'study=s'                 => \@studies,
+           'study=i'                 => \@study_ids,
            'verbose'                 => \$verbose) or die "\n$what_on_earth\n";
 
 if ($log4perl_config) {
@@ -117,68 +106,45 @@ sub _uid_to_irods_uid {
   return grep {/^\Q$u\E#/smx} @public;
 }
 
-Readonly::Scalar my $GROUP_SECONDARY_MEMBERS_FIELD_INDEX => 3;
-my%ug2id; #cache of group to users - populate here
-my%gid2group;
-my $num_group_lines = 0;
-open my$gfh, q(-|), q(getent group) or
-  $log->logcroak("Opening pipe to getent group failed: $ERRNO");
-while(<$gfh>){
-  $num_group_lines++;
-  chomp;
-  $log->debug("getent group: ", $_);
-  my@F=split /:/smx;
-  my$users=$ug2id{$F[0]}||=[];
-  push @{$users}, split /,/smx, $F[$GROUP_SECONDARY_MEMBERS_FIELD_INDEX]||q(); #fill with secondary groups for users
-  $gid2group{$F[2]}=$F[0];
-}
-close $gfh or
-  $log->logcroak("Closing pipe to getent group failed: $ERRNO");
-
-if ($group_min_record_count and $num_group_lines < $group_min_record_count) {
-  $log->logcroak("Output of 'getent group' appears truncated ",
-                 "($num_group_lines lines)");
-}
-
-Readonly::Scalar my $PASSWD_PRIMARY_GID_FIELD_INDEX => 3;
-
-my $num_passwd_lines = 0;
-open my$pfh, q(-|), q(getent passwd) or
-  $log->logcroak("Opening pipe to getent passwd failed: $ERRNO");
-while(<$pfh>){
-  $num_passwd_lines++;
-  chomp;
-  $log->debug("getent passwd: ", $_);
-  my@F=split /:/smx;
-  push @{$ug2id{$gid2group{$F[$PASSWD_PRIMARY_GID_FIELD_INDEX]}||=q()}},$F[0]; #fill with primary group for users - empty strong used if no group found for gid
-}
-close $pfh or
-  $log->logcroak("Closing pipe to getent passwd failed: $ERRNO");
-
-if ($passwd_min_record_count and $num_passwd_lines < $passwd_min_record_count) {
-  $log->logcroak("Output of 'getent passwd' appears truncated ",
-                 "($num_passwd_lines lines)");
+my $host = 'ldap.internal.sanger.ac.uk';
+my $ldap = Net::LDAP->new($host);
+
+$ldap->bind or $log->logcroak("LDAP failed to bind to '$host': ", $!);
+# Get group, gid and member uids from LDAP
+my ($group2uids, $gid2group) = find_group_ids($ldap);
+# Get uids and their primary gid from LDAP
+my $uid2gid = find_primary_gid($ldap);
+$ldap->unbind or $log->logwarn("LDAP failed to unbind '$host': ", $!);
+
+# For each uid, merge primary gid with secondary gids
+foreach my $uid (keys %{$uid2gid}) {
+  my $gid           = $uid2gid->{$uid};
+  my $primary_group = $gid2group->{$gid};
+
+  # Some users in LDAP have a gidNumber that does not correspond to a
+  # Unix group
+  if (defined $primary_group) {
+    push @{$group2uids->{$primary_group}}, $uid;
+  }
 }
 
-foreach my $users (values%ug2id){
-  $users = [uniq @{$users}];
+foreach my $group (keys %{$group2uids}){
+  my @uids = uniq @{$group2uids->{$group}};
+  $group2uids->{$group} = \@uids;
+  $log->debug("Group '$group' membership ", join q(, ), @uids);
 }
 
-my $schema = npg_warehouse::Schema->connect;
-my $rs;
-if (@studies) {
-  $rs = $schema->resultset(q(CurrentStudy))->search({internal_id => \@studies});
-}
-else {
-  $rs = $schema->resultset(q(CurrentStudy));
-}
+my $mlwh = WTSI::DNAP::Warehouse::Schema->connect;
+my $query = @study_ids ? {id_study_lims => \@study_ids} : {};
+my $studies = $mlwh->resultset('Study')->search($query,
+                                                {order_by => 'id_study_lims'});
 
 my ($group_count, $altered_count) = (0, 0);
-while (my $study = $rs->next){
-  my $study_id = $study->internal_id;
+while (my $study = $studies->next){
+  my $study_id = $study->id_study_lims;
   my $dag_str  = $study->data_access_group || q();
-  my $is_seq   = $study->npg_information->count ||
-                 $study->npg_plex_information->count;
+  my $is_seq   = $study->iseq_flowcells->count ||
+                 $study->pac_bio_runs->count;
 
   $log->debug("Working on study $study_id, SScape data access: '$dag_str'");
 
@@ -187,8 +153,8 @@ sub _uid_to_irods_uid {
   if (@dags) {
     # if strings from data access group don't match any group name try
     # treating as usernames
-    @members = map { _uid_to_irods_uid($_)   }
-               map { @{ $ug2id{$_} || [$_] } } @dags;
+    @members = map { _uid_to_irods_uid($_) }
+               map { @{ $group2uids->{$_} || [$_] } } @dags;
   }
   elsif ($is_seq) {
     @members = @public;
@@ -212,3 +178,50 @@ sub _uid_to_irods_uid {
 $log->info("When considering $group_count Sequencescape studies, ",
            "$altered_count iRODS groups were created or their ",
            'membership altered (by ', $iga->_user, ')');
+
+# Find both gid and member uids for each group
+sub find_group_ids {
+  my ($ld) = @_;
+
+  my $query_base   = 'ou=group,dc=sanger,dc=ac,dc=uk';
+  my $query_filter = '(cn=*)';
+  my $search = $ld->search(base   => $query_base,
+                           filter => $query_filter);
+  if ($search->code) {
+    $log->logcroak("LDAP query base: '$query_base', filter: '$query_filter' ",
+                   'failed: ', $search->error);
+  }
+
+  my %group2uids;
+  my %gid2group;
+  foreach my $entry ($search->entries) {
+    my $group   = $entry->get_value('cn');
+    my $gid     = $entry->get_value('gidNumber');
+    my @uids    = $entry->get_value('memberUid');
+
+    $group2uids{$group} = \@uids;
+    $gid2group{$gid}    = $group;
+  }
+
+  return (\%group2uids, \%gid2group);
+}
+
+sub find_primary_gid {
+  my ($ld) = @_;
+
+  my $query_base   = 'ou=people,dc=sanger,dc=ac,dc=uk';
+  my $query_filter = '(sangerActiveAccount=TRUE)';
+    my $search = $ld->search(base   => $query_base,
+                             filter => $query_filter);
+  if ($search->code) {
+    $log->logcroak("LDAP query base: '$query_base', filter: '$query_filter' ",
+                   'failed: ', $search->error);
+  }
+
+  my %uid2gid;
+  foreach my $entry ($search->entries) {
+    $uid2gid{$entry->get_value('uid')} = $entry->get_value('gidNumber');
+  }
+
+  return \%uid2gid;
+}