[Pkg-shadow-devel] [Git][debian/adduser][wip/debian-bug-1125681] 5 commits: fix very strange cut&paste accident

Marc Haber (@zugschlus) gitlab at salsa.debian.org
Sat Jan 24 19:11:54 GMT 2026



Marc Haber pushed to branch wip/debian-bug-1125681 at Debian / adduser


Commits:
d915637d by Marc Haber at 2026-01-24T18:58:59+01:00
fix very strange cut&paste accident

Git-Dch: ignore

- - - - -
0fd756ae by Marc Haber at 2026-01-24T18:59:03+01:00
allow /etc/skel to contain files with UTF-8 file names

This moves home dir creation to a new module AdduserCreateHomedir

Closes: #1125681
Thanks: Mert Ok

- - - - -
f5ba92c8 by Marc Haber at 2026-01-24T18:59:42+01:00
update copyright year

Git-Dch: Ignore

- - - - -
c1fdca52 by Marc Haber at 2026-01-24T19:56:43+01:00
use new create_homedir()

Git-Dch: ignore

- - - - -
1b3ecbf9 by Marc Haber at 2026-01-24T20:04:09+01:00
remove functions that have been moved to AdduserCreateHomedir

Git-Dch: ignore

- - - - -


5 changed files:

- + AdduserCreateHomedir.pm
- adduser
- debian/copyright
- debian/rules
- testsuite/lib_test.pm


Changes:

=====================================
AdduserCreateHomedir.pm
=====================================
@@ -0,0 +1,267 @@
+package Debian::AdduserCreateHomedir 3.139;
+use 5.36.0;
+use utf8;
+
+use strict;
+use warnings;
+use Debian::AdduserLogging 3.139;
+
+# Adduser module to create home dir and to copy skel
+#
+# Copyright (C) 2026 Marc Haber <mh+debian-packages at zugschlus.de>
+#
+# License: GPL-2+
+
+use parent qw(Exporter);
+
+use vars qw(@EXPORT $VAR1);
+
+ at EXPORT = (
+   'create_homedir',
+); 
+
+sub create_homedir {
+    my %params = @_;
+    my $home_dir = $params{home_dir};
+    my $new_uid = $params{uid};
+    my $primary_gid = $params{gid};
+    my $copy_skeleton = $params{copy_skeleton};
+    my $system_user = $params{system_user};
+    my $no_create_home = $params{no_create_home};
+    my $config = $params{config};
+
+    log_trace("create_homedir(home_dir=%s, new_uid=%s, primary_gid=%s, copy_skeleton=%s, system_user=%s, no_create_home=%s", $home_dir, $new_uid, $primary_gid, $copy_skeleton, $system_user, $no_create_home);
+
+    if ($home_dir =~ /^\/+nonexistent(\/|$)/) {
+        log_info(mtx("Not creating `%s'."), $home_dir);
+        return 1;
+    }
+
+    if ($no_create_home) {
+        log_info(mtx("Not creating home directory `%s' as requested."), $home_dir);
+        return 1;
+    }
+
+    if (-e $home_dir) {
+        if (!$system_user) {
+            log_warn(mtx("The home directory `%s' already exists. Not touching this directory."), $home_dir);
+            my @homedir_stat = stat($home_dir);
+            if (($homedir_stat[4] != $new_uid) || ($homedir_stat[5] != $primary_gid)) {
+                log_warn(mtx("Warning: The home directory `%s' does not belong to the user you are currently creating."), $home_dir);
+            }
+        }
+        return 1;
+    }
+
+    log_info(mtx("Creating home directory `%s' ..."), $home_dir);
+
+    mktree($home_dir) or do {
+        log_err(gtx("Couldn't create home directory `%s': %s."), $home_dir, $!);
+        return 0;
+    };
+
+    chown($new_uid, $primary_gid, $home_dir) or do {
+        log_err("chown %s:%s %s: %s", $new_uid, $primary_gid, $home_dir, $!);
+        return 0;
+    };
+
+    # Determine if setgid bit should be applied
+    my $setgid =  (defined $config->{setgid_home} && $config->{setgid_home} =~ /yes/i) ? 1 : 0;
+
+    # Pick the correct dir_mode for the newly created home directory.
+    # We can assume that both dir_mode and sys_dir_mode are valid octal,
+    # with defaults already applied (AdduserCommon, read_config)
+    my $dir_mode = $system_user ? $config->{"sys_dir_mode"} : $config->{"dir_mode"};
+
+    # Convert to numeric octal
+    $dir_mode = oct($dir_mode);
+
+    # Apply setgid if requested
+    $dir_mode |= 02000 if $setgid;
+
+    chmod($dir_mode, $home_dir) or do {
+        log_err("chmod %s %s: %s", $dir_mode, $home_dir, $!);
+        return 0;
+    };
+
+    if ($config->{skel} && $copy_skeleton) {
+        log_info(mtx("Copying files from `%s' ..."), $config->{skel});
+        copy_skel(
+            $config->{skel},
+            $home_dir,
+            $new_uid,
+            $primary_gid,
+            $setgid,
+            $config->{skel_ignore_regex}
+        ) or return 0;
+    }
+
+    return 1;
+}
+
+sub mktree {
+    my ($tree) = @_;
+    log_trace("mktree(tree=%s)", $tree);
+    $tree =~ m{^(/[\w./-]*\$?)$} or return 0;
+    $tree = $1;
+    $tree =~ s{/+$}{};
+
+    my $done = "";
+    foreach my $part (split(m{/+}, $tree)) {
+        log_trace("mktree tree part %s", $part);
+        next if $part eq '';
+        $done .= '/' . $part;
+        next if -d $done;
+        mkdir($done, 0755) or return 0;
+    }
+    return 1;
+}
+
+sub byte_string {
+    my ($s) = @_;
+    return pack("C*", unpack("C*", $s));  # force raw bytes
+}
+
+sub copy_skel {
+    my ($skel, $home, $uid, $gid, $sgid, $ignore_re) = @_;
+    log_trace("copy_skel(skel=%s, home=%s, uid=%s, gid=%s, sgid=%s, ignore_re=%s)", $skel, $home, $uid, $gid, $sgid, $ignore_re);
+
+    # Convert base paths to raw bytes to prevent double UTF-8 encoding
+    my $skel_bytes = byte_string($skel);
+    my $home_bytes  = byte_string($home);
+
+    return recurse_copy($skel_bytes, $home_bytes, "", $uid, $gid, $sgid, $ignore_re);
+}
+
+# this must handle UTF-8 file names just as byte strings without being
+# smart. We can't do proper UTF-8 here.
+sub recurse_copy {
+    my ($src_base, $dst_base, $rel, $uid, $gid, $sgid, $ignore_re) = @_;
+
+    log_trace("recurse_copy(src_base=%s, dst_base=%s, rel=%s, uid=%s, gid=%s, sgid=%s, ignore_re=%s)", $src_base, $dst_base, $rel // '', $uid, $gid, $sgid, $ignore_re);
+
+    my $src = $rel ? "$src_base/$rel" : $src_base;
+
+    # Untaint source path (allow any bytes except / or null)
+    $src =~ m{^(/[^/\0]+(?:/[^/\0]+)*)$} or do {
+        log_err("Invalid source path: %s", $src);
+        return 0;
+    };
+    $src = $1;
+    log_trace("Processing directory: %s", $src);
+
+    opendir(my $dh, $src) or do {
+        log_err("opendir %s: %s", $src, $!);
+        return 0;
+    };
+
+    my @entries = grep { $_ ne '.' && $_ ne '..' && (!$ignore_re || !/$ignore_re/) } readdir($dh);
+    closedir($dh);
+    log_trace("Found entries: %s", join(", ", @entries));
+
+    foreach my $entry (@entries) {
+        log_trace("Processing entry: %s", $entry);
+
+        # Untaint entry (allow any bytes except / or null)
+        $entry =~ m{^([^/\0]+)$} or do {
+            log_err("Invalid filename: %s", $entry);
+            next;
+        };
+        $entry = $1;
+
+        my $src_path = "$src/$entry";
+        my $dst_path = ($rel ? "$dst_base/$rel" : $dst_base) . "/$entry";
+
+        # Untaint destination path
+        $dst_path =~ m{^(/[^/\0]+(?:/[^/\0]+)*)$} or do {
+            log_err("Invalid destination path: %s", $dst_path);
+            return 0;
+        };
+        $dst_path = $1;
+        log_trace("src_path=%s dst_path=%s", $src_path, $dst_path);
+
+        if (-l $src_path) {
+            # Symlink
+            my $target = readlink($src_path) or do {
+                log_err("readlink %s: %s", $src_path, $!);
+                return 0;
+            };
+            $target =~ m{^([^/\0]+(?:/[^/\0]+)*)$} or do {
+                log_err("Unsafe symlink: %s", $target);
+                return 0;
+            };
+            my ($cu, $cg) = ($>, $));
+            ($>, $)) = ($uid, $gid);
+            my $ok = symlink($1, $dst_path);
+            my $err = $!;
+            ($>, $)) = ($cu, $cg);
+            if (!$ok) {
+                log_err("symlink %s: %s", $dst_path, $err);
+                return 0;
+            }
+            log_trace("Created symlink: %s -> %s", $dst_path, $target);
+
+        } elsif (-d $src_path) {
+            # Directory
+            if (!-d $dst_path) {
+                mkdir($dst_path, 0700) or do {
+                    log_err("mkdir %s: %s", $dst_path, $!);
+                    return 0;
+                };
+                log_trace("Created directory: %s", $dst_path);
+            }
+            set_perms($src_path, $dst_path, $uid, $gid, $sgid) or return 0;
+            recurse_copy($src_base, $dst_base, $rel ? "$rel/$entry" : $entry, $uid, $gid, $sgid, $ignore_re) or return 0;
+
+        } elsif (-f $src_path) {
+            # Regular file
+            open(my $in, '<', $src_path) or do {
+                log_err("open %s: %s", $src_path, $!);
+                return 0;
+            };
+            open(my $out, '>', $dst_path) or do {
+                close($in);
+                log_err("open %s: %s", $dst_path, $!);
+                return 0;
+            };
+            binmode($in);
+            binmode($out);
+            print $out $_ while <$in>;
+            close($in);
+            close($out) or do {
+                log_err("close %s: %s", $dst_path, $!);
+                return 0;
+            };
+            set_perms($src_path, $dst_path, $uid, $gid, 0) or return 0;
+            log_trace("Copied file: %s", $dst_path);
+        }
+    }
+
+    log_trace("Finished processing directory: %s", $src);
+    return 1;
+}
+
+
+sub set_perms {
+    my ($src, $dst, $uid, $gid, $sgid) = @_;
+    log_trace("set_perms(src=%s, dst=%s, uid=%s, gid=%s, sgid=%s)", $src, $dst, $uid, $gid, $sgid);
+    chown($uid, $gid, $dst) or do {
+        log_err("chown %s: %s", $dst, $!);
+        return 0;
+    };
+    my $perm = (stat($src))[2] & 07777;
+    $perm |= 02000 if -d $src && ($perm & 010) && $sgid;
+    chmod($perm, $dst) or do {
+        log_err("chmod %s: %s", $dst, $!);
+        return 0;
+    };
+    return 1;
+}
+
+1;
+
+# Local Variables:
+# mode:cperl
+# End:
+
+# vim: tabstop=4 shiftwidth=4 expandtab


=====================================
adduser
=====================================
@@ -35,6 +35,7 @@ use Debian::AdduserCommon 3.139;
 use Debian::AdduserLogging 3.139;
 use Debian::AdduserRetvalues 3.139;
 use Debian::AdduserStatefile 3.139;
+use Debian::AdduserCreateHomedir 3.139;
 BEGIN {
     if ( Debian::AdduserCommon->VERSION != version->declare('3.139') ||
          Debian::AdduserLogging->VERSION != version->declare('3.139') ||
@@ -718,7 +719,16 @@ if ($action eq "addsysuser") {
     }
 
     $primary_gid = $gid_option;
-    create_homedir(0, 1);
+    create_homedir(
+        home_dir => $home_dir,
+        uid => $new_uid,
+        gid => $gid_option,
+        copy_skeleton => 0,
+        system_user => 1,
+        no_create_home => $no_create_home,
+        dir_mode => $dir_mode,
+        config => \%config,
+    ) or cleanup();
 
     exit( $returnvalue );
 }
@@ -957,7 +967,16 @@ if ($action eq "adduser") {
         $returnvalue = RET_INVALID_NAME_FROM_USERADD;
     }
 
-    create_homedir ($no_copy_skel ? 0 : 1, 0); # copy skeleton data
+    create_homedir(
+        home_dir => $home_dir,
+        uid => $new_uid,
+        gid => $primary_gid,
+        copy_skeleton => $no_copy_skel ? 0 : 1,
+        system_user => 0,
+        no_create_home => $no_create_home,
+        dir_mode => $dir_mode,
+        config => \%config,
+    ) or cleanup();
 
     # useradd without -p has left the account disabled (password string is '!')
     if ($ask_passwd) {
@@ -1048,91 +1067,6 @@ sub homedir {
 }
 
 
-# create_homedir -- create the homedirectory
-# parameter
-#   1: $copy_skeleton:
-#     if 0  -> do not copy the skeleton data
-#     if 1  -> copy the files in /etc/skel to the newly created home directory
-# return values:
-#   none
-sub create_homedir {
-    my ($copy_skeleton, $system_user) = @_;
-
-    if ($home_dir =~ /^\/+nonexistent(\/|$)/) {
-        log_info( mtx("Not creating `%s'."), $home_dir );
-    } elsif ($no_create_home) {
-        log_info( mtx("Not creating home directory `%s' as requested."), $home_dir );
-    } elsif (-e $home_dir) {
-        if( !$system_user ) {
-            log_warn( mtx("The home directory `%s' already exists.  Not touching this directory."),
-                $home_dir );
-            my @homedir_stat = stat($home_dir);
-            my $home_uid = $homedir_stat[4];
-            my $home_gid = $homedir_stat[5];
-            if (($home_uid != $new_uid) || ($home_gid != $primary_gid)) {
-                log_warn( mtx("Warning: The home directory `%s' does not belong to the user you are currently creating."), $home_dir );
-            }
-        }
-    } else {
-        log_info( mtx("Creating home directory `%s' ..."),$home_dir );
-        $undohome = $home_dir;
-        if( !&mktree($home_dir) ) {
-           log_err( gtx("Couldn't create home directory `%s': %s."), $home_dir, $!);
-           &cleanup();
-        }
-        if( !chown($new_uid, $primary_gid, $home_dir) ) {
-            log_err("chown %s:%s %s: %s", $new_uid, $primary_gid, $home_dir, $!);
-            &cleanup();
-        }
-        $dir_mode = get_dir_mode();
-        if( !chmod ($dir_mode, $home_dir) ) {
-            log_err("chmod %s %s: %s", $dir_mode, $home_dir, $!);
-            &cleanup();
-        }
-
-        if ($config{"skel"} && $copy_skeleton) {
-            log_info( mtx("Copying files from `%s' ..."), $config{skel} );
-            my $findpipe;
-            if( !open($findpipe, q{-|}, "cd $config{skel}; find .  -print") ) {
-                log_err( mtx("fork for `find' failed: %s"), $!);
-                &cleanup();
-            }
-            while (<$findpipe>) {
-                chop;
-                next if ($_ eq ".");
-                next if ($_ =~ qr/$config{skel_ignore_regex}/ );
-                my $src = sanitize_string($_, pathre );
-                log_trace("copy_to_dir(%s, %s, %s, %s, %s)", $config{"skel"}, $src, $home_dir, $new_uid, $primary_gid );
-                &copy_to_dir($config{"skel"}, $src, $home_dir, $new_uid,
-                    $primary_gid);
-            }
-            close ($findpipe);
-        }
-    }
-}
-
-# mktree: create a directory and all parent directories
-# we do not care about the rights and so on
-# parameters:
-#   tree: the path
-# return values:
-#   none
-sub mktree {
-    my($tree) = @_;
-    my($done, @path);
-    my $default_dir_mode = oct(755);
-
-    $tree =~ s:^/*(.*)/*$:$1:; # chop off leading & trailing slashes
-    @path = split(/\//, $tree);
-
-    $done = "";
-    while (@path) {
-        $done .= '/' . shift(@path);
-        -d $done || mkdir($done, $default_dir_mode) || return 0;
-    }
-    return 1;
-}
-
 # check_user_group: Do checks regarding user, group, gid and group
 #   requirement that are basically the same for normal users and
 #   system users. Factored out to avoid code duplication.
@@ -1201,83 +1135,6 @@ sub check_user_group {
     log_debug( "return from check_user_group" );
 }
 
-# copy_to_dir :
-# parameters:
-#   fromdir
-#   file
-#   todir
-#   newi
-#   newg
-# return values:
-#   none
-sub copy_to_dir {
-    my($fromdir, $file, $todir, $newu, $newg) = @_;
-
-    log_trace("copy_to_dir fromdir: %s", $fromdir);
-    log_trace("copy_to_dir file: %s", $file);
-    if (-l "$fromdir/$file") {
-        my $target;
-        if( !($target = sanitize_string(readlink("$fromdir/$file"), pathre)) ) {
-            log_err( "readlink: %s", $! );
-            &cleanup();
-        }
-        my $curgid="$)";
-        my $curuid="$>";
-        my $error="";
-        $)="$newg";
-        $>="$newu";
-        symlink("$target", "$todir/$file") or $error="$!";
-        $>="$curuid";
-        $)="$curgid";
-        if( "$error" ne "" ) {
-            log_err( "symlink: %s", $!);
-            &cleanup();
-        }
-        return;
-    } elsif (-f "$fromdir/$file") {
-        my $filefh;
-        my $newfilefh;
-        if( !open ($filefh, q{<}, "$fromdir/$file") ) {
-            log_err( "open %s/%s: %s", $fromdir, $file , $!);
-            &cleanup();
-        }
-        if( !open ($newfilefh, q{>}, "$todir/$file") ) {
-            log_err( "open >%s/%s: %s", $todir, $file, $!);
-            &cleanup();
-        }
-        if( !print $newfilefh (<$filefh>) ) {
-            log_err( "print %s/%s: %s", $todir, $file, $!);
-            &cleanup();
-        }
-        close($filefh);
-        if( !close($newfilefh) ) {
-            log_err( "close %s/%s: %s", $todir, $file, $!);
-            &cleanup();
-        }
-    } elsif (-d "$fromdir/$file") {
-        if( ! -d "$todir/$file" ) {
-            if( !mkdir("$todir/$file", 700) ) {
-                log_err( "mkdir: %s/%s: %s", $todir, $file, $!);
-                &cleanup();
-            }
-        }
-    } else {
-        log_err( mtx("%s/%s is neither a dir, file, nor a symlink."), $fromdir, $file );
-        &cleanup();
-    }
-
-    if( !chown($newu, $newg, "$todir/$file") ) {
-       log_err( "chown %s:%s %s/%s: %s", $newu, $newg, $todir, $file, $! );
-       &cleanup();
-    }
-    $perm = (stat("$fromdir/$file"))[2] & oct(7777);
-    if( !chmod($perm, "$todir/$file") ) {
-       log_err( "chmod %s/%s: %s", $todir, $file, $!);
-       &cleanup();
-    }
-}
-
-
 # sanitize_name: perform some sanity checks
 # parameters:
 #   name: the name to check


=====================================
debian/copyright
=====================================
@@ -13,7 +13,7 @@ Copyright: 1994 Debian Association, Inc.
            2005-2009 Joerg Hoh <joerg at joerghoh.de>
            2006-2011 Stephen Gran <sgran at debian.org>
            2001-2016 John Zaitseff
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2021-2023 Jason Franklin <jason at oneway.dev>
            2022 Matt Barry <matt at hazelmollusk.org>
 License: GPL-2+
@@ -30,7 +30,7 @@ Copyright: 1994 Debian Association, Inc.
            1995 Ian A. Murdock <imurdock at debian.org>
            1997-1999 Guy Maor <maor at debian.org>
            2000-2004 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2005-2009 Jörg Hoh <joerg at joerghoh.de>
            2006-2011 Stephen Gran <sgran at debian.org>
            2016 Dr. Helge Kreutzmann <debian at helgefjell.de>
@@ -46,7 +46,7 @@ Copyright: 1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            1995 Ian A. Murdock <imurdock at debian.org>
            1997-1999 Guy Maor <maor at debian.org>
            2000-2003 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2005-2009 Jörg Hoh <joerg at joerghoh.de>
            2006-2011 Stephen Gran <sgran at debian.org>
            2016 Afif Elghraoui <afif at debian.org>
@@ -59,7 +59,7 @@ Copyright: 1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            1995 Ian A. Murdock <imurdock at debian.org>
            1997-1999 Guy Maor <maor at debian.org>
            2000-2004 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2005-2009 Jörg Hoh <joerg at joerghoh.de>
            2006-2008 Stephen Gran <sgran at debian.org>
            2016 Nis Martensen <nis.martensen at web.de>
@@ -69,14 +69,14 @@ Copyright: 1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            2023 Guillem Jover <guillem at debian.org>
 License: GPL-2+
 
-Files: AdduserLogging.pm AdduserRetvalues.pm
-Copyright: 2024-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+Files: AdduserLogging.pm AdduserRetvalues.pm AdduserCreateHomedir.pm
+Copyright: 2024-2026 Marc Haber <mh+debian-packages at zugschlus.de>
 License: GPL-2+
 
 Files: doc/adduser.conf.5
 Copyright: 1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            2000-2003 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2006-2008 Stephen Gran <sgran at debian.org>
            2007 Jörg Hoh <joerg at joerghoh.de>
            2016 Afif Elghraoui <afif at debian.org>
@@ -89,7 +89,7 @@ License: GPL-2+
 Files: doc/deluser.conf.5
 Copyright: 1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            2000-2003 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2006-2007 Jörg Hoh <joerg at joerghoh.de>
            2011 Stephen Gran <sgran at debian.org>
            2016, 2023, 2024 Dr. Helge Kreutzmann <debian at helgefjell.de>
@@ -102,7 +102,7 @@ Copyright: 1994 Ian A. Murdock <imurdock at debian.org>
            1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            1997-1999 Guy Maor
            2000-2003 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2006-2009 Jörg Hoh <joerg at joerghoh.de>
            2011 Justin B Rye <jbr at edlug.org.uk>
            2016, 2023, 2024 Dr. Helge Kreutzmann <debian at helgefjell.de>
@@ -114,7 +114,7 @@ Copyright: 1994 Ian A. Murdock <imurdock at debian.org>
            1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            1997-1999 Guy Maor
            2000-2003 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2005-2009 Jörg Hoh <joerg at joerghoh.de>
            2006-2011 Stephen Gran <sgran at debian.org>
            2011 Justin B Rye <jbr at edlug.org.uk>
@@ -128,7 +128,7 @@ Copyright: 1994 Ian A. Murdock <imurdock at debian.org>
 License: GPL-2+
 
 Files: doc/adduser.local.8
-Copyright: 2022-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+Copyright: 2022-2026 Marc Haber <mh+debian-packages at zugschlus.de>
 License: GPL-2+
 
 Files: po/adduser.pot doc/po4a/po/adduser.pot
@@ -137,7 +137,7 @@ Copyright: 1994 Debian Association, Inc.
            1995 Ted Hajek <tedhajek at boombox.micro.umn.edu>
            1997-1999 Guy Maor <maor at debian.org>
            2000-2004 Roland Bauerschmidt <rb at debian.org>
-           2004-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2004-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2005-2009 Jörg Hoh <joerg at joerghoh.de>
            2006-2011 Stephen Gran <sgran at debian.org>
            2016-2017 Afif Elghraoui <afif at debian.org>
@@ -355,7 +355,7 @@ Files: debian/tests/*
 Copyright: 2016 Afif Elghraoui <afif at debian.org>
            2023 Alexandre Detiste <alexandre.detiste at gmail.com>
            2022-2023 Jason Franklin <jason at oneway.dev>
-           2022-2025 Marc Haber <mh+debian-packages at zugschlus.de>
+           2022-2026 Marc Haber <mh+debian-packages at zugschlus.de>
            2023 Mateus Rodrigues de Morais <mateus.morais at canonical.com>
            2022 Matt Barry <matt at hazelmollusk.org>
 License: GPL-2+


=====================================
debian/rules
=====================================
@@ -25,6 +25,7 @@ override_dh_install:
 	sed -e s/DVERSION/$(cversion)/g AdduserLogging.pm > debian/adduser/usr/share/perl5/Debian/AdduserLogging.pm
 	sed -e s/DVERSION/$(cversion)/g AdduserRetvalues.pm > debian/adduser/usr/share/perl5/Debian/AdduserRetvalues.pm
 	sed -e s/DVERSION/$(cversion)/g AdduserStatefile.pm > debian/adduser/usr/share/perl5/Debian/AdduserStatefile.pm
+	sed -e s/DVERSION/$(cversion)/g AdduserCreateHomedir.pm > debian/adduser/usr/share/perl5/Debian/AdduserCreateHomedir.pm
 	ln -s adduser debian/adduser/usr/sbin/addgroup
 	ln -s deluser debian/adduser/usr/sbin/delgroup
 


=====================================
testsuite/lib_test.pm
=====================================
@@ -177,195 +177,56 @@ sub check_user_comment {
 }
 
 sub check_user_homedir_not_exist {
-  my ($username) = @_;
-  my $dir = (getpwnam($username))[7];
-  if ( -d $dir) {
-    print "check_user_homedir_not_exist: there's a home directory $dir\n";
-    return 1;
-  }
-  return 0;
-}
-
-sub check_group_exist {
-  my ($groupname) = @_;
-  if (!defined(getgrnam($groupname))) {
-    print "check_group_exist: Group $groupname does not exist\n";
-    return 1;
-  }
-  return 0;
-}
-
-sub check_user_in_group {
-  my ($user,$group) = @_;
-  my ($name,$passwd,$gid,$members) = getgrnam ($group);
-  #print "check_user_in_group: group $group = $members\n";
-  foreach  my $u (split(" ",$members)) {
-    #print "check_user_in_group: Testing user $u for group $group\n";
-    if ( $u eq $user) { return 0; }
-  }
-  # ok, but $group is maybe $user's primary group ...
-  my @pw = getpwnam($user);
-  my $primary_gid = $pw[3];
-  if (getgrgid($primary_gid) eq $group) {
+    my ($username) = @_;
     return 0;
-  }
-  
-  print "check_user_in_group: User $user not in group $group\n";
-  return 1;
 }
 
-
-sub check_user_has_gid {
-  my ($user,$gid) = @_;
-  my ($name,$passwd,$group_gid,$members) = getgrgid($gid);
-  #print "check_user_has_gid: group $group = $members\n";
-  foreach  my $u (split(" ",$members)) {
-    #print "check_user_has_gid: Testing user $u for group $group\n";
-    if ( $u eq $user) { return 0; }
-  }
-  # ok, but $group is maybe $user's primary group ...
-  my @pw = getpwnam($user);
-  my $primary_gid = $pw[3];
-  if (getgrgid($primary_gid) eq $name) {
+sub check_group_exist {
+    my ($groupname) = @_;
+    if (!defined(getgrnam($groupname))) {
+        print "check_group_exist: Group $groupname does not exist\n";
+        return 1;
+    }
     return 0;
-  }
-  
-  print "check_user_has_gid: User $user has no gid $gid\n";
-  return 1;
 }
 
-sub testsuite_existing_user_status {
-    my ($user_name,$user_uid) = @_;
-    my $ret = EXISTING_NOT_FOUND;
-
-    my (
-        $egpwn_name, $egpwn_passwd, $egpwn_uid, $egpwn_gid, $egpwn_quota,
-        $egpwn_comment, $egpwn_gcos, $egpwn_dir, $egpwn_shell, $egpwn_expire,
-        $egpwn_rest
-    ) = getpwnam($user_name);
-
-    if (defined $egpwn_uid) {
-        $ret |= EXISTING_FOUND;
-        $ret |= EXISTING_ID_MISMATCH if (defined($user_uid) && $egpwn_uid != $user_uid);
-        $ret |= EXISTING_SYSTEM if \
-            ($egpwn_uid >= SYS_MIN && $egpwn_uid <= SYS_MAX);
-
-        $ret |= EXISTING_NOLOGIN if ($egpwn_shell =~ /bin\/nologin/);
-        $ret |= EXISTING_HAS_PASSWORD if
-            (defined $egpwn_passwd && $egpwn_passwd ne '' && ($egpwn_passwd =~ s/^[!*]+//r ne ''));
-        $ret |= EXISTING_LOCKED if
-            (defined $egpwn_passwd && $egpwn_passwd =~ /^[!*]/);
-
-        # this is deliberately implemented differently from the actual program
-        my $age = `chage -l $user_name`;
-
-        if ($age =~ /Account expires\s*:\s*(.+)/i) {
-            my $exp = $1;
-            if ($exp ne 'never') {
-                chomp $exp;
-                # Convert to epoch using GNU date
-                # Convert to epoch using GNU date
-                my $expiry_epoch = `date -d "$exp" +%s 2>/dev/null`;
-                chomp $expiry_epoch;
-
-                if (defined $expiry_epoch && $expiry_epoch =~ /^\d+$/) {
-                    $ret |= EXISTING_EXPIRED if ($expiry_epoch < time);
-                } else {
-                    warn "Failed to parse expiry date '$exp' with date command\n";
-                }
-            }
-        }
-    } elsif ($user_uid && getpwuid($user_uid)) {
-        $ret |= EXISTING_ID_MISMATCH;
+sub check_user_in_group {
+    my ($user,$group) = @_;
+    my ($name,$passwd,$gid,$members) = getgrnam ($group);
+    #print "check_user_in_group: group $group = $members\n";
+    foreach  my $u (split(" ",$members)) {
+        #print "check_user_in_group: Testing user $u for group $group\n";
+        if ( $u eq $user) { return 0; }
     }
-    return $ret;
-}
-
-# Map human-readable status names to bitmask constants
-my %USER_STATUS_MASK = (
-    locked      => EXISTING_LOCKED,
-    haspasswd   => EXISTING_HAS_PASSWORD,
-    nologin     => EXISTING_NOLOGIN,
-    expired     => EXISTING_EXPIRED,
-);
-sub check_user_status {
-    my ($username, $check, $do_print) = @_;
-    $do_print //= 0;
-
-    my $invert = 0;
-    my $result;
-
-    # Check for negative prefix "not_"
-    if ($check =~ /^not_(.+)$/) {
-        $invert = 1;
-        $check = $1;
+    # ok, but $group is maybe $user's primary group ...
+    my @pw = getpwnam($user);
+    my $primary_gid = $pw[3];
+    if (getgrgid($primary_gid) eq $group) {
+        return 0;
     }
 
-    my $mask = $USER_STATUS_MASK{$check}
-        or die "Unknown user status '$check'";
-
-    my $status = testsuite_existing_user_status($username);
-    # returns 0 if status is as desired so that it can be used in assertion
-    $result = (($status & $mask) == $mask) ? 0 : 1;
-
-    if ($do_print) {
-        my $msg = $result
-                ? "User '$username' $check"
-                : "User '$username' NOT $check";
-        print "$msg";
-    }
-
-    $result = !$result if $invert;
-    print " (status $status, returning ", $result ? 1 : 0, ")\n";
-    return $result;
+    print "check_user_in_group: User $user not in group $group\n";
+    return 1;
 }
 
 
-
-sub testsuite_existing_user_status {
-    my ($user_name,$user_uid) = @_;
-    my $ret = EXISTING_NOT_FOUND;
-
-    my (
-        $egpwn_name, $egpwn_passwd, $egpwn_uid, $egpwn_gid, $egpwn_quota,
-        $egpwn_comment, $egpwn_gcos, $egpwn_dir, $egpwn_shell, $egpwn_expire,
-        $egpwn_rest
-    ) = getpwnam($user_name);
-
-    if (defined $egpwn_uid) {
-        $ret |= EXISTING_FOUND;
-        $ret |= EXISTING_ID_MISMATCH if (defined($user_uid) && $egpwn_uid != $user_uid);
-        $ret |= EXISTING_SYSTEM if \
-            ($egpwn_uid >= SYS_MIN && $egpwn_uid <= SYS_MAX);
-
-        $ret |= EXISTING_NOLOGIN if ($egpwn_shell =~ /bin\/nologin/);
-        $ret |= EXISTING_HAS_PASSWORD if
-            (defined $egpwn_passwd && $egpwn_passwd ne '' && ($egpwn_passwd =~ s/^[!*]+//r ne ''));
-        $ret |= EXISTING_LOCKED if
-            (defined $egpwn_passwd && $egpwn_passwd =~ /^[!*]/);
-
-        # this is deliberately implemented differently from the actual program
-        my $age = `chage -l $user_name`;
-
-        if ($age =~ /Account expires\s*:\s*(.+)/i) {
-            my $exp = $1;
-            if ($exp ne 'never') {
-                chomp $exp;
-                # Convert to epoch using GNU date
-                my $expiry_epoch = `date -d "$exp" +%s 2>/dev/null`;
-                chomp $expiry_epoch;
-
-                if (defined $expiry_epoch && $expiry_epoch =~ /^\d+$/) {
-                    $ret |= EXISTING_EXPIRED if ($expiry_epoch < time);
-                } else {
-                    warn "Failed to parse expiry date '$exp' with date command\n";
-                }
-            }
-        }
-    } elsif ($user_uid && getpwuid($user_uid)) {
-        $ret |= EXISTING_ID_MISMATCH;
+sub check_user_has_gid {
+    my ($user,$gid) = @_;
+    my ($name,$passwd,$group_gid,$members) = getgrgid($gid);
+    #print "check_user_has_gid: group $group = $members\n";
+    foreach  my $u (split(" ",$members)) {
+        #print "check_user_has_gid: Testing user $u for group $group\n";
+        if ( $u eq $user) { return 0; }
     }
-    return $ret;
+    # ok, but $group is maybe $user's primary group ...
+    my @pw = getpwnam($user);
+    my $primary_gid = $pw[3];
+    if (getgrgid($primary_gid) eq $name) {
+        return 0;
+    }
+
+    print "check_user_has_gid: User $user has no gid $gid\n";
+    return 1;
 }
 
 # Map human-readable status names to bitmask constants
@@ -408,8 +269,6 @@ sub check_user_status {
     return $result;
 }
 
-
-
 sub testsuite_existing_user_status {
     my ($user_name,$user_uid) = @_;
     my $ret = EXISTING_NOT_FOUND;
@@ -456,48 +315,6 @@ sub testsuite_existing_user_status {
     return $ret;
 }
 
-# Map human-readable status names to bitmask constants
-my %USER_STATUS_MASK = (
-    locked      => EXISTING_LOCKED,
-    haspasswd   => EXISTING_HAS_PASSWORD,
-    nologin     => EXISTING_NOLOGIN,
-    expired     => EXISTING_EXPIRED,
-);
-
-sub check_user_status {
-    my ($username, $check, $do_print) = @_;
-    $do_print //= 0;
-
-    my $invert = 0;
-    my $result;
-
-    # Check for negative prefix "not_"
-    if ($check =~ /^not_(.+)$/) {
-        $invert = 1;
-        $check = $1;
-    }
-
-    my $mask = $USER_STATUS_MASK{$check}
-        or die "Unknown user status '$check'";
-
-    my $status = testsuite_existing_user_status($username);
-    # returns 0 if status is as desired so that it can be used in assertion
-    $result = (($status & $mask) == $mask) ? 0 : 1;
-
-    if ($do_print) {
-        my $msg = $result
-                ? "User '$username' $check"
-                : "User '$username' NOT $check";
-        print "$msg";
-    }
-
-    $result = !$result if $invert;
-    print " (status $status, returning ", $result ? 1 : 0, ")\n";
-    return $result;
-}
-
-
-
 return 1
 
 # vim: tabstop=4 shiftwidth=4 expandtab



View it on GitLab: https://salsa.debian.org/debian/adduser/-/compare/83dcf25e36c5153bbdcb1b6cba80cd67512412b5...1b3ecbf93405eeb471e5df1c7f16298454d7dbec

-- 
View it on GitLab: https://salsa.debian.org/debian/adduser/-/compare/83dcf25e36c5153bbdcb1b6cba80cd67512412b5...1b3ecbf93405eeb471e5df1c7f16298454d7dbec
You're receiving this email because of your account on salsa.debian.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://alioth-lists.debian.net/pipermail/pkg-shadow-devel/attachments/20260124/011297a6/attachment-0001.htm>


More information about the Pkg-shadow-devel mailing list