view release on metacpan or  search on metacpan

t/03-userdb.t  view on Meta::CPAN

   my $save_dir = catdir($tmp, 'save_test');
   mkdir $save_dir;
   $db->save($save_dir);
   
   ok(-f catfile($save_dir, 'passwd'), 'passwd file created');
   ok(-f catfile($save_dir, 'group'), 'group file created');
   ok(-f catfile($save_dir, 'shadow'), 'shadow file created');
   
   my $saved_passwd = slurp(catfile($save_dir, 'passwd'));
   like($saved_passwd, qr/testuser:x:1001:1001/, 'saved passwd contains testuser');
   
   my $saved_group = slurp(catfile($save_dir, 'group'));
   like($saved_group, qr/testgroup:.*?:1001:alice/, 'saved group contains membership');
};

subtest 'roundtrip load and save' => sub {
   # Create original test data
   my $orig_dir = catdir($tmp, 'orig');
   mkdir $orig_dir;
   
   my $passwd_data = <<~'END';
      root:*:0:0:root:/root:/bin/bash
      testuser:x:1001:1001:Test User:/home/testuser:/bin/bash
      alice:x:1002:1002:Alice:/home/alice:/bin/bash
      END
   mkfile(catfile($orig_dir, 'passwd'), $passwd_data);
   
   my $group_data = <<~'END';
      root:*:0:
      wheel:*:10:alice
      users:*:100:alice,testuser
      testuser:*:1001:
      alice:*:1002:
      END
   mkfile(catfile($orig_dir, 'group'), $group_data);
   
   my $shadow_data = <<~'END';
      testuser:$6$salt$hash:19000:0:99999:7:::
      alice:!:19001::::::
      END
   mkfile(catfile($orig_dir, 'shadow'), $shadow_data);
   
   # Load, then save
   my $db = Sys::Export::Unix::UserDB->new;
   $db->load($orig_dir);
   
   my $save_dir = catdir($tmp, 'roundtrip');
   mkdir $save_dir;
   $db->save($save_dir);
   
   is( slurp(catfile($save_dir, 'passwd')), $passwd_data, 'passwd' );
   is( slurp(catfile($save_dir, 'group')),  $group_data,  'group' );
   is( slurp(catfile($save_dir, 'shadow')), $shadow_data, 'shadow' );
};

subtest 'auto import from host' => sub {
   my ($user0, $group0);
   # presume every host has a 'root' user and group
   # This always throws an exception on Win32 "The getpwman function is unimplemented"
   unless (eval {
      $user0= getpwuid 0;
      $group0= getgrgid 0;
      0 == (getpwnam($user0)//-1) && 0 == (getgrnam($group0)//-1)
   }) {
      note "error checking uid/gid 0: $@";
      skip_all "This host doesn't have a root user?";
   }

   my $db = Sys::Export::Unix::UserDB->new(auto_import => 1);
   is( $db->user($user0),
      object {
         call uid => 0;
         call group => $group0;
      },
      "auto-loaded user '$user0'"
   );
   is( $db->group($group0),
      object {
         call gid => 0;
      },
      "auto-loaded group '$group0'"
   );
};

done_testing;