perl -w and adduser
>I thought I had found a bug in adduser and started having a look at
>the code. First thing I noticed is it didn't have perl -w so I
>added it, then realised there wasn't a bug, just user error
>
>Anyway, here is the code to allow adduser(8) have perl -w. I have
>tested and can see no functional change (apart from 2 simple variable
>type checks at the end).
>
Perhaps better to use "use warnings" instead of perl -w.
-mark
Index: adduser.perl
===
RCS file: /cvs/src/usr.sbin/adduser/adduser.perl,v
retrieving revision 1.53
diff -u -p -r1.53 adduser.perl
--- adduser.perl3 Jan 2007 15:26:04 - 1.53
+++ adduser.perl4 May 2011 04:39:41 -
@@ -28,6 +28,8 @@
#
# $From: adduser.perl,v 1.22 1996/12/07 21:25:12 ache Exp $
+use warnings;
+
use IPC::Open2;
use Fcntl qw(:DEFAULT :flock);
@@ -667,7 +669,11 @@ sub new_users_group_update {
}
# group membership might have changed
else {
- push(@a, "$gid{$e}:*:$e:$groupmembers{$e}");
+ if ($groupmembers{$e}) {
+ push(@a, "$gid{$e}:*:$e:$groupmembers{$e}");
+ } else {
+ push(@a, "$gid{$e}:*:$e:");
+ }
}
}
# append empty YP group
@@ -788,7 +794,7 @@ sub new_users {
local($new_users_ok) = 1;
-$new_groups = "no" unless $groupname{$new_groups};
+$new_groups = "no";
while(1) {
$name = &new_users_name;
@@ -952,7 +958,8 @@ USAGE
# uniq(1)
sub uniq {
local(@list) = @_;
-local($e, $last = "", @array);
+local($e, $last, @array);
+$last = "";
foreach $e (sort @list) {
push(@array, $e) unless $e eq $last;
@@ -1030,7 +1037,7 @@ sub hints {
sub parse_arguments {
local(@argv) = @_;
-while ($_ = $argv[0], /^-/) {
+while (@argv && ($_ = $argv[0], /^-/)) {
shift @argv;
last if /^--$/;
if(/^--?(v|verbose)$/) { $verbose = 1 }
@@ -1285,11 +1292,11 @@ sub confirm_list {
# otherwise 0
sub confirm_yn {
local($message, $confirm) = @_;
-local($yes) = '^(yes|YES|y|Y)$';
-local($no) = '^(no|NO|n|N)$';
+local($yes) = '^(yes|YES|y|Y|1)$';
+local($no) = '^(no|NO|n|N|0)$';
local($read, $c);
-if ($confirm && ($confirm =~ "$yes" || $confirm == 1)) {
+if ($confirm && ($confirm =~ "$yes")) {
$confirm = "y";
} else {
$confirm = "n";
@@ -1532,7 +1539,7 @@ verbose = $verbose
# Get new password for new users
# defaultpasswd = yes | no
-defaultpasswd = $defaultpasswd
+defaultpasswd = "$defaultpasswd"
# Default encryption method for user passwords
# Methods are all those listed in login.conf(5)
@@ -1572,7 +1579,7 @@ uid_start = $uid_start
uid_end = $uid_end
# default login.conf(5) login class
-defaultclass = $defaultclass
+defaultclass = "$defaultclass"
# login classes available from login.conf(5)
# login_classes = ('default', 'daemon', 'staff')
@@ -1589,6 +1596,10 @@ EOF
# check for sane variables
sub variable_check {
# Check uid_start & uid_end
+ die "ERROR: uid_start not a number\n"
+ if(!($uid_start =~ /^[+-]?\d+$/));
+ die "ERROR: uid_end not a number\n"
+ if(!($uid_end =~ /^[+-]?\d+$/));
warn "WARNING: uid_start < 1000!\n" if($uid_start < 1000);
die "ERROR: uid_start >= uid_end!\n" if($uid_start >= $uid_end);
# unencrypted really only usable in batch mode
perl -w and adduser(8)
I thought I had found a bug in adduser and started having a look at
the code. First thing I noticed is it didn't have perl -w so I
added it, then realised there wasn't a bug, just user error
Anyway, here is the code to allow adduser(8) have perl -w. I have
tested and can see no functional change (apart from 2 simple variable
type checks at the end).
oks/comments?
-mark
If there is interest in this kind of thing I'm sure I could look at
rmuser.8
Index: adduser.perl
===
RCS file: /cvs/src/usr.sbin/adduser/adduser.perl,v
retrieving revision 1.53
diff -u -p -r1.53 adduser.perl
--- adduser.perl3 Jan 2007 15:26:04 - 1.53
+++ adduser.perl3 May 2011 09:48:58 -
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
#
# $OpenBSD: adduser.perl,v 1.53 2007/01/03 15:26:04 simon Exp $
#
@@ -667,7 +667,11 @@ sub new_users_group_update {
}
# group membership might have changed
else {
- push(@a, "$gid{$e}:*:$e:$groupmembers{$e}");
+ if ($groupmembers{$e}) {
+ push(@a, "$gid{$e}:*:$e:$groupmembers{$e}");
+ } else {
+ push(@a, "$gid{$e}:*:$e:");
+ }
}
}
# append empty YP group
@@ -788,7 +792,7 @@ sub new_users {
local($new_users_ok) = 1;
-$new_groups = "no" unless $groupname{$new_groups};
+$new_groups = "no";
while(1) {
$name = &new_users_name;
@@ -952,7 +956,8 @@ USAGE
# uniq(1)
sub uniq {
local(@list) = @_;
-local($e, $last = "", @array);
+local($e, $last, @array);
+$last = "";
foreach $e (sort @list) {
push(@array, $e) unless $e eq $last;
@@ -1030,7 +1035,7 @@ sub hints {
sub parse_arguments {
local(@argv) = @_;
-while ($_ = $argv[0], /^-/) {
+while (@argv && ($_ = $argv[0], /^-/)) {
shift @argv;
last if /^--$/;
if(/^--?(v|verbose)$/) { $verbose = 1 }
@@ -1285,11 +1290,11 @@ sub confirm_list {
# otherwise 0
sub confirm_yn {
local($message, $confirm) = @_;
-local($yes) = '^(yes|YES|y|Y)$';
-local($no) = '^(no|NO|n|N)$';
+local($yes) = '^(yes|YES|y|Y|1)$';
+local($no) = '^(no|NO|n|N|0)$';
local($read, $c);
-if ($confirm && ($confirm =~ "$yes" || $confirm == 1)) {
+if ($confirm && ($confirm =~ "$yes")) {
$confirm = "y";
} else {
$confirm = "n";
@@ -1532,7 +1537,7 @@ verbose = $verbose
# Get new password for new users
# defaultpasswd = yes | no
-defaultpasswd = $defaultpasswd
+defaultpasswd = "$defaultpasswd"
# Default encryption method for user passwords
# Methods are all those listed in login.conf(5)
@@ -1572,7 +1577,7 @@ uid_start = $uid_start
uid_end = $uid_end
# default login.conf(5) login class
-defaultclass = $defaultclass
+defaultclass = "$defaultclass"
# login classes available from login.conf(5)
# login_classes = ('default', 'daemon', 'staff')
@@ -1589,6 +1594,10 @@ EOF
# check for sane variables
sub variable_check {
# Check uid_start & uid_end
+ die "ERROR: uid_start not a number\n"
+ if(!($uid_start =~ /^[+-]?\d+$/));
+ die "ERROR: uid_end not a number\n"
+ if(!($uid_end =~ /^[+-]?\d+$/));
warn "WARNING: uid_start < 1000!\n" if($uid_start < 1000);
die "ERROR: uid_start >= uid_end!\n" if($uid_start >= $uid_end);
# unencrypted really only usable in batch mode
