Use File::Basename::dirname().

To correctly extract the parent directory of the socket path.  The
previous returned an empty string when the socket path didn't contain
‘/’.

4 files changed, 11 insertions, 5 deletions

diff --git a/Changelog b/Changelog
index 4d18b38..5bca11e 100644
--- a/Changelog
+++ b/Changelog
@@ -62,6 +62,8 @@ lacme (0.7.1) upstream;
  - Use 'acme-challenge.XXXXXXXXXX' as template for the temporary ACME
    challenge directory.
  - Set the DEBUG environment variable to 0/1 instead of ""/1.
+ - Use File::Basename::dirname() to correctly extract the parent
+   directory of the socket path.
 
  -- Guilhem Moulin <guilhem@fripost.org>  Wed, 09 Dec 2020 18:23:22 +0100
 
diff --git a/INSTALL b/INSTALL
index 9ecb1bf..cb8d57f 100644
--- a/INSTALL
+++ b/INSTALL
@@ -4,6 +4,7 @@ lacme-accountd depends on the following Perl modules:
   - Crypt::OpenSSL::RSA (for PEM-encoded key material)
   - Crypt::OpenSSL::Bignum (for PEM-encoded key material)
   - Errno (core module)
+  - File::Basename (core module)
   - Getopt::Long (core module)
   - JSON (optionally C/XS-accelerated with JSON::XS)
   - List::Util (core module)
@@ -23,6 +24,7 @@ lacme depends on OpenSSL ≥1.1.0 and the following Perl modules:
   - Date::Parse
   - Errno (core module)
   - Fcntl (core module)
+  - File::Basename (core module)
   - File::Temp (core module)
   - Getopt::Long (core module)
   - JSON (optionally C/XS-accelerated with JSON::XS)
diff --git a/lacme b/lacme
index 3d3657f..2f239e2 100755
--- a/lacme
+++ b/lacme
@@ -27,6 +27,7 @@ my $NAME = 'lacme';
 
 use Errno 'EINTR';
 use Fcntl qw/F_GETFD F_SETFD FD_CLOEXEC O_CREAT O_EXCL O_WRONLY SEEK_SET/;
+use File::Basename 'dirname';
 use File::Temp ();
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
 use List::Util 'first';
@@ -531,8 +532,8 @@ sub acme_client($@) {
         $sockname = $sockname =~ /\A(\p{Print}+)\z/ ? $1 : die "Invalid socket name\n"; # untaint $sockname
 
         # ensure we're the only user with write access to the parent dir
-        my $dirname = $sockname =~ s/[^\/]+$//r;
-        @stat = stat($dirname) or die "stat($dirname): $!";
+        my $dirname = dirname($sockname);
+        @stat = stat($dirname) or die "stat($dirname): $!\n";
         die "Error: insecure permissions on $dirname\n" if ($stat[2] & 0022) != 0;
 
         # ensure we're the only user with read/write access to the socket
@@ -695,7 +696,7 @@ elsif ($COMMAND eq 'newOrder' or $COMMAND eq 'new-cert') {
                   : [ "$NAME-certs.conf", "$NAME-certs.conf.d/" ];
     my ($conf, %defaults);
     foreach my $conffile (@$conffiles) {
-        $conffile = ($CONFFILENAME =~ s#[^/]+\z##r).$conffile unless $conffile =~ /\A\//;
+        $conffile = dirname($CONFFILENAME) .'/'. $conffile unless $conffile =~ /\A\//;
         my @filenames;
         unless ($conffile =~ s#/\z## or -d $conffile) {
             @filenames = ($conffile);
diff --git a/lacme-accountd b/lacme-accountd
index 7b9b1ff..1dc5f03 100755
--- a/lacme-accountd
+++ b/lacme-accountd
@@ -28,6 +28,7 @@ my $PROTOCOL_VERSION = 1;
 my $NAME = 'lacme-accountd';
 
 use Errno 'EINTR';
+use File::Basename 'dirname';
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
 use List::Util 'first';
 use MIME::Base64 'encode_base64url';
@@ -143,8 +144,8 @@ unless (defined $OPTS{stdio}) {
     $sockname = $sockname =~ /\A(\p{Print}+)\z/ ? $1 : die "Invalid socket name\n"; # untaint $sockname
 
     # ensure we're the only user with write access to the parent dir
-    my $dirname = $sockname =~ s/[^\/]+$//r;
-    my @stat = stat($dirname) or die "stat($dirname): $!";
+    my $dirname = dirname($sockname);
+    my @stat = stat($dirname) or die "stat($dirname): $!\n";
     die "Error: insecure permissions on $dirname\n" if ($stat[2] & 0022) != 0;
 
     my $umask = umask(0177) // die "umask: $!";