From 3610ab59b2085c5eda3933690a973bad1760d3d4 Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Wed, 21 Aug 2019 09:48:09 +0300
Subject: Use Config::Parser::Ini for configuration

---
 acmeman                        | 181 +----------------
 lib/App/Acmeman/Config.pm      | 446 +++++++++++------------------------------
 lib/App/Acmeman/Source/File.pm |  14 +-
 3 files changed, 130 insertions(+), 511 deletions(-)

diff --git a/acmeman b/acmeman
index 7d8a8ac..ddd4703 100755
--- a/acmeman
+++ b/acmeman
@@ -2,7 +2,7 @@
 #! -*-perl-*-
 eval 'exec perl -x -wS $0 ${1+"$@"}'
     if 0;
-# Copyright (C) 2017, 2018 Sergey Poznyakoff <gray@gnu.org>
+# Copyright (C) 2017-2019 Sergey Poznyakoff <gray@gnu.org>
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -906,13 +906,6 @@ sub get_root_cert {
 
 sub initial_setup {
     get_root_cert('/etc/ssl/acme/lets-encrypt-x3-cross-signed.pem');
-    unless ($config->isset(qw(core source))) {
-	require App::Acmeman::Source::Apache;
-	my $src = new App::Acmeman::Source::Apache;
-	$src->configure($config);
-	$config->set(qw(core source), $src) unless $config->success;
-	$config->clrerr;
-    }
 
     foreach my $src ($config->get(qw(core source))) {
 	unless ($src->setup(dry_run => $dry_run, force => $force)) {
@@ -956,7 +949,7 @@ sub myip {
 	$ips = {};
 	my $addhost;
 	
-	if ($config->isset(qw(core my-ip))) {
+	if ($config->is_set(qw(core my-ip))) {
 	    $addhost = 0;
 	    foreach my $ip ($config->get(qw(core my-ip))) {
 		if ($ip eq '$hostip') {
@@ -988,7 +981,7 @@ sub host_ns_ok {
 
 sub collect {
     my $aref = shift;
-    return unless $config->isset('domain');
+    return unless $config->is_set('domain');
     my $err;
     while (my ($k, $v) = each %{$config->get('domain')}) {
 	my $dom;
@@ -1056,171 +1049,21 @@ GetOptions("h" => sub {
 
 ++$debug if $dry_run;
 
-sub cb_parse_bool {
-    my ($k, $vref) = @_;
-    my %bt = (
-	0 => 0,
-	off => 0,
-	false => 0,
-	no => 0,
-	1 => 1,
-	on => 1,
-	true => 1,
-	yes => 1
-    );
-    my $res = $bt{lc($$vref)};
-    if (defined($res)) {
-	$$vref = $res;
-	return undef;
-    }
-    return "not a boolean: $$vref";
-}
-
-my %syntax = (
-    core => {
-	section => {
-	    postrenew => { array => 1 },
-	    rootdir => { default => '/var/www/acme' },
-	    files => 1,
-	    'time-delta' => { default => 86400 },
-	    source => { default => [ 'apache' ], array => 1 },
-	    'check-alt-names' => { default => 0, parser => \&cb_parse_bool },
-	    'check-dns' => { default => 1, parser => \&cb_parse_bool },
-	    'my-ip' => { array => 1 },
-            'key-size' => { re => '^\d+$', default => 4096 }
-	}
-    },
-    files => {
-	section => {
-	    '*' => {
-		section => {
-		    type => { re => 'single|split', default => 'split' },
-		    'certificate-file' => { mandatory => 1 },
-		    'key-file' => 1,
-		    'ca-file' => 1,
-		    argument => 1,
-		}
-	    }
-	}
-    },
-    domain => {
-	section => {
-	    '*' => {
-		section => {
-		    alt => { array => 1 },
-		    files => 1,
-		    'key-size' => { re => '^\d+$' },
-		    postrenew => 0
-		}
-	    }
-	}
-    }
-);		
-
-sub file_type_fixup {
-    my $err;
-
-    $config->set(qw(core files default))
-	unless $config->isset(qw(core files));
-
-    unless ($config->isset(qw(files))) {
-	if ($config->get(qw(core files)) ne 'default') {
-	    error("section files." . $config->get(qw(core files))." not defined");
-	    ++$err;
-	}
-    }
-
-    unless ($config->isset(qw(files default))) {
-	$config->set(qw(files default type), 'split');
-	$config->set(qw(files default key-file), 
-		     '/etc/ssl/acme/$domain/privkey.pem');
-	$config->set(qw(files default certificate-file),
-		     '/etc/ssl/acme/$domain/cert.pem');
-	$config->set(qw(files default ca-file),
-		     '/etc/ssl/acme/$domain/ca.pem');
-    }
-    
-    if ($config->isset(qw(files))) {
-	while (my ($k, $v) = each %{$config->get(qw(files))}) {
-	    if ($v->{type} eq 'single') {
-		unless (exists($v->{'certificate-file'})) {
-		    error("files.$k.certificate-file not defined");
-		    ++$err;
-		} else {
-		    if (exists($v->{'key-file'})) {
-			error("files.$k.key-file ignored");
-		    }
-		    if (exists($v->{'ca-file'})) {
-			error("files.$k.ca-file ignored");
-		    }
-		}
-	    } else {
-		unless (exists($v->{'key-file'})) {
-		    error("files.$k.key-file not defined");
-		    ++$err;
-		}
-		unless (exists($v->{'certificate-file'})) {
-		    error("files.$k.ca-file not defined");
-		    ++$err;
-		}
-	    }
-	}
-    }
-
-    if (my $files = $config->get(qw(core files))) {
-	unless ($config->isset('files', $files)) {
-	    error("files.$files is referenced from [core], but never declared");
-	    ++$err;
-	}
-    }
-    
-    exit(1) if $err;
-}
-
 my @domlist;
 
 @select{map { lc } @ARGV} = (1) x @ARGV;
 
-$config = new App::Acmeman::Config($config_file,
-				   syntax => \%syntax,
-				   defaults => {
-				       'core.source' => 'apache',
-                                       'core.key-size' => 4096
-				   });
-
-if ($config->success) {
-    if (my @source = $config->get(qw(core source))) {
-	$config->unset(qw(core source));
-	foreach my $s (@source) {
-	    my ($name, @args) = quotewords('\s+', 0, $s);
-	    my $pack = 'App::Acmeman::Source::' . ucfirst($name);
-	    my $obj = eval "use $pack; new $pack(\@args);";
-	    if ($@) {
-		abend(EX_CONFIG, $@);
-	    }
-	    $obj->configure($config);
-	    $config->set(qw(core source), $obj);
-	}
-    }
-    if ($time_delta) {
-	$config->set(qw(core time-delta), $time_delta);
-    }
-    if ($check_alt_names) {
-	$config->set(qw(core check-alt-names), $check_alt_names);
-    }
-    $config->finalize;
-}
+$config = new App::Acmeman::Config($config_file);
 
-unless ($config->success) {
-    foreach my $err ($config->errors) {
-	error($err);
-    }
-    exit(1);
+if ($time_delta) {
+    $config->set(qw(core time-delta), $time_delta);
+}
+if ($check_alt_names) {
+    $config->set(qw(core check-alt-names), $check_alt_names);
 }
 
 initial_setup if $setup;
 
-file_type_fixup;
 #print Dumper([$config]);exit;
 collect \@domlist;
 
@@ -1230,10 +1073,6 @@ coalesce \@domlist;
 # Check challenge root directory
 prep_dir($config->get(qw(core rootdir)).'/file');
 
-# # FIXME Check filename patterns
-# abend(EX_CONFIG, "filename patterns not defined")
-#     unless (defined($filename_arg) && defined($filename_pattern{cert}));
-
 $challenge = Protocol::ACME::Challenge::LocalFile->new({
     www_root => $config->get(qw(core rootdir))
 });
@@ -1253,7 +1092,7 @@ foreach my $vhost (@domlist) {
 }
 
 if ($renewed) {
-    if ($config->isset(qw(core postrenew))) {
+    if ($config->is_set(qw(core postrenew))) {
 	foreach my $cmd ($config->get(qw(core postrenew))) {
 	    runcmd($cmd);
 	}
diff --git a/lib/App/Acmeman/Config.pm b/lib/App/Acmeman/Config.pm
index 99b6aec..6860428 100644
--- a/lib/App/Acmeman/Config.pm
+++ b/lib/App/Acmeman/Config.pm
@@ -3,375 +3,153 @@ package App::Acmeman::Config;
 use strict;
 use warnings;
 use Carp;
-
-require Exporter;
-our @ISA = qw(Exporter);
-our $VERSION = "1.00";
-
-sub new {
-    my ($class, $filename, %args) = @_;
-    my $self = bless { _filename => $filename }, $class;
-    my $defaults;
-    my $v;
-
-    if (defined($v = delete $args{syntax})) {
-	$self->{_syntax} = $v;
+use parent 'Config::Parser::Ini';
+use Text::ParseWords;
+
+use constant EX_CONFIG => 78;
+
+sub check_bool {
+    my ($self, $vref, $prev_value, $locus) = @_;
+    my %bt = (
+	0 => 0,
+	off => 0,
+	false => 0,
+	no => 0,
+	1 => 1,
+	on => 1,
+	true => 1,
+	yes => 1
+    );
+    my $res = $bt{lc($$vref)};
+    unless (defined($res)) {
+	$self->error("not a boolean: $$vref");
+	return 0;
     }
-    $defaults = delete $args{defaults};
 
-    carp "unrecognized parameters" if keys(%args);
-    $self->{_conf} = {};
-    if (-e $filename) {
-	$self->_readconfig($filename, $self->{_conf});
-    } elsif ($defaults) {
-	while (my ($k, $v) = each %$defaults) {
-	    $self->set(split(/\./, $k), $v);
-	}
-    } else {
-	$self->error("configuration file \"$filename\" does not exist");
-    }
-    $self->finalize;  
-    return $self;
+    $$vref = $res;
+    return 1;
 }
 
-sub finalize {
-    my $self = shift;
-    if ($self->success && exists($self->{_syntax})) {
-	$self->_fixup($self->{_syntax}, $self->{_conf});
+sub new {
+    my $class = shift;
+    my $filename = shift;
+    my %args;
+    if (-e $filename) {
+	$args{filename} = $filename;
     }
-}
-
-sub error {
-    my ($self, $msg) = @_;
-    push @{$self->{_errors}}, $msg;
-}
-
-sub errors {
-    my $self = shift;
-    if (wantarray) {
-	return exists($self->{_errors}) ? (@{$self->{_errors}}) : ();
-    } elsif (!exists($self->{_errors})) {
-	return 0;
-    } else {
-	return 0 + @{$self->{_errors}};
+    my $self = $class->SUPER::new(%args);
+    if (!$args{filename}) {
+	$self->commit or croak "configuration failed";
     }
+    $self
 }
 
-sub clrerr {
+sub mangle {
     my $self = shift;
-    delete $self->{_errors};
-}
-
-sub success {
-    my $self = shift;
-    return $self->errors == 0;
-}
+    my $err;
 
-sub _parse_section {
-    my ($self, $conf, $input) = @_;
-    my $quote;
-    my $kw = $self->{_syntax} if exists $self->{_syntax};
-    while ($input ne '') {
-	my $name;
-	if (!defined($quote)) {
-	    if ($input =~ /^"(.*)/) {
-		$quote = '';
-		$input = $1;
-	    } elsif ($input =~ /^(.+?)(?:\s+|")(.*)/) {
-		$name = $1;
-		$input = $2;
-	    } else {
-		$name = $input;
-		$input = '';
-	    }
-	} else {
-	    if ($input =~ /^([^\\"]*)\\(.)(.*)/) {
-		$quote .= $1 . $2;
-		$input = $3;
-	    } elsif ($input =~ /^([^\\"]*)"\s*(.*)/) {
-		$name = $quote . $1;
-		$input = $2;
-		$quote = undef;
-	    } else {
-		error("unparsable input $input");
-		exit(2);
-	    }
-	}
+    $self->set(qw(core files default))
+	unless $self->is_set(qw(core files));
 
-	if (defined($name)) {	    
-	    $conf->{$name} = {} unless ref($conf->{$name}) eq 'HASH';
-	    $conf = $conf->{$name};
-	    if (defined($kw) and ref($kw) eq 'HASH') {
-		my $synt;
-                if (exists($kw->{$name})) {
-                    $synt = $kw->{$name};
-                } elsif (exists($kw->{'*'})) {
-                    $synt = $kw->{'*'};
-                    if ($synt eq '*') {
-                        $name = undef;
-                        next;
-                    }
-                }
-		if (defined($synt)
-                    && ref($synt) eq 'HASH'
-                    && exists($synt->{section})) {
-                    $kw = $synt->{section};
-                } else {
-                    $kw = undef;
-                }
-            } else {
-                $kw = undef;
-            }
-	    $name = undef;
+    unless ($self->is_set(qw(files))) {
+	if ($self->get(qw(core files)) ne 'default') {
+	    $self->error("section files." . $self->get(qw(core files))." not defined");
+	    ++$err;
 	}
     }
-    return ($conf, $kw);
-}
 
-sub _readconfig {
-    my ($self, $file, $conf) = @_;
-
-#    debug(2, "reading $file");
-    open(my $fd, "<", $file)
-	or do {
-	    $self->error("can't open configuration file $file: $!");
-	    return;
-    };
-    
-    my $line;
-    my $err;
-    my $section = $conf;
-    my $kw = $self->{_syntax};
-    my $include = 0;
-    my $rootname;
+    unless ($self->is_set(qw(files default))) {
+	$self->set(qw(files default type), 'split');
+	$self->set(qw(files default key-file), 
+		     '/etc/ssl/acme/$domain/privkey.pem');
+	$self->set(qw(files default certificate-file),
+		     '/etc/ssl/acme/$domain/cert.pem');
+	$self->set(qw(files default ca-file),
+		     '/etc/ssl/acme/$domain/ca.pem');
+    }
     
-    while (<$fd>) {
-	++$line;
-	chomp;
-	if (/\\$/) {
-	    chop;
-	    $_ .= <$fd>;
-	    redo;
-	}
-	
-	s/^\s+//;
-	s/\s+$//;
-	s/#.*//;
-	next if ($_ eq "");
-
-	if (/^\[(.+?)\]$/) {
-	    $include = 0;
-	    my $arg = $1;
-	    $arg =~ s/^\s+//;
-	    $arg =~ s/\s+$//;
-	    if ($arg eq 'include') {
-		$include = 1;
-	    } else {
-		($section, $kw) = $self->_parse_section($conf, $1);
-		if (exists($self->{_syntax}) && !defined($kw)) {
-		    $self->error("$file:$line: unknown section");
-		}
-	    }
-	} elsif (/([\w_-]+)\s*=\s*(.*)/) {
-	    my ($k, $v) = ($1, $2);
-
-	    if ($include) {
-		if ($k eq 'path') {
-		    $self->_readconfig($v, $conf);
-		} elsif ($k eq 'pathopt') {
-		    $self->_readconfig($v, $conf)
-			if -f $v;
-		} elsif ($k eq 'glob') {
-		    foreach my $file (bsd_glob($v, 0)) {
-			$self->_readconfig($file, $conf);
-		    }
+    if (my $fnode = $self->getnode('files')) {
+	while (my ($k, $v) = each %{$fnode->subtree}) {
+	    $v->set('files', $k, 'type', 'split')
+		unless $v->has_key('type', 'split');
+	    if ($v->subtree('type') eq 'single') {
+		unless ($v->has_key('certificate-file')) {
+		    $self->error("files.$k.certificate-file not defined");
+		    ++$err;
 		} else {
-		    $self->error("$file:$line: unknown keyword");
-		}
-		next;
-	    }
-
-	    if (defined($kw)) {
-		my $x = $kw->{$k};
-		if (!defined($x)) {
-		    $self->error("$file:$line: unknown keyword $k");
-		    next;
-		} elsif (ref($x) eq 'HASH') {
-		    if (exists($x->{re})) {
-			if ($v !~ /$x->{re}/) {
-			    $self->error("$file:$line: invalid value for $k");
-			    next;
-			}
-		    }
-
-		    if (exists($x->{check})) {
-			if (my $errstr = &{$x->{check}}($k, $v)) {
-			    $self->error("$file:$line: $errstr");
-			    next;
-			}
+		    if ($v->has_key('key-file')) {
+			$self->error("files.$k.key-file ignored");
 		    }
-		    
-		    if (exists($x->{parser})) {
-			if (my $errstr = &{$x->{parser}}($k, \$v)) {
-			    $self->error("$file:$line: $errstr");
-			    next;
-			}
-		    }
-			
-		    if ($x->{array}) {
-			if (exists($section->{$k})) {
-			    $v = [ @{$section->{$k}}, $v ];
-			} else {
-			    $v = [ $v ]
-			}
+		    if ($v->has_key('ca-file')) {
+			$self->error("files.$k.ca-file ignored");
 		    }
 		}
-	    }
-
-            $section->{$k} = $v;
-        } else {
-    	    $self->error("$file:$line: malformed line");
-	    next;
-	}
-    }
-    close $fd;
-}
-
-sub _is_section_ref {
-    my ($ref) = @_;
-    return ref($ref) eq 'HASH';
-}
-
-sub _fixup {
-    my ($self, $kw, $section, @path) = @_;
-
-    while (my ($k, $d) = each %{$kw}) {
-	if (ref($d) eq 'HASH') {	    
-	    if (exists($d->{default}) && !exists($section->{$k})) {
-		$section->{$k} = $d->{default};
-	    }
-
-	    if (exists($d->{section})) {
-		if ($k eq '*') {
-		    while (my ($name, $vref) = each %{$section}) {
-			if (_is_section_ref($vref)) {
-			    $self->_fixup($d->{section}, $vref, @path, $name);
-			}
-		    }
-		} else {
-		    my $temp;
-		    unless (exists $section->{$k}) {
-			$section->{$k} = {} ;
-			$temp = 1;
-		    }
-		    $self->_fixup($d->{section}, $section->{$k}, @path, $k);
-		    delete $section->{$k}
-		        if $temp && keys(%{$section->{$k}}) == 0;
+	    } else {
+		unless ($v->has_key('key-file')) {
+		    $self->error("files.$k.key-file not defined");
+		    ++$err;
+		}
+		unless ($v->has_key('certificate-file')) {
+		    $self->error("files.$k.ca-file not defined");
+		    ++$err;
 		}
 	    }
-	    
-	    if ($d->{mandatory} && !exists($section->{$k})) {
-		$self->error(exists($d->{section})
-			     ? "mandatory section ["
-			        . join(' ', @path, $k)
-				. "] not present"
-		             : "mandatory variable \""
-			        . join('.', @path, $k)
-			        . "\" not set");
-	    }	    
 	}
     }
-}	
 
-sub _getref {
-    my $self = shift;
-
-    return undef unless exists $self->{_conf};
-    my $ref = $self->{_conf};
-    for (@_) {
-	carp "component undefined" unless defined $_;
-	return undef unless exists $ref->{$_};
-	$ref = $ref->{$_};
+    if (my $files = $self->get(qw(core files))) {
+	unless ($self->is_set('files', $files)) {
+	    $self->error("files.$files is referenced from [core], but never declared");
+	    ++$err;
+	}
     }
-    return $ref;
-}
 
-sub get {
-    my $self = shift;
-    if (my $ref = $self->_getref(@_)) {
-	if (ref($ref) eq 'ARRAY') {
-	    if (wantarray) {
-		return (@{$ref});
-	    } else {
-		return $ref->[0];
+    if (my @source = $self->get(qw(core source))) {
+	$self->unset(qw(core source));
+	foreach my $s (@source) {
+	    my ($name, @args) = quotewords('\s+', 0, $s);
+	    my $pack = 'App::Acmeman::Source::' . ucfirst($name);
+	    my $obj = eval "use $pack; new $pack(\@args);";
+	    if ($@) {
+		$self->error($@);
+	        ++$err;
+	        next;
 	    }
+	    $obj->configure($self);
+	    $self->set(qw(core source), $obj);
 	}
-	return $ref;
     }
-}
 
-sub isset {
-    my $self = shift;
-    return defined $self->_getref(@_);
+    exit(EX_CONFIG) if $err;
 }
 
-sub unset {
-    my $self = shift;
-    my $last = pop;
 
-    return unless exists $self->{_conf};
-    my $ref = $self->{_conf};
-    for (@_) {
-        carp "component undefined" unless defined $_;
-        return unless exists $ref->{$_};
-        $ref = $ref->{$_};
-    }
-    delete $ref->{$last};
-}
-
-sub set {
-    my $self = shift;
-    $self->{_conf} = {} unless exists $self->{_conf};
-    my $ref = $self->{_conf};
-    my $synt = $self->{_syntax};
-
-#    print "SET ".join('.',@_)."\n";
-    while (my $arg = shift) {
-	if ($synt) {
-	    if (exists($synt->{$arg})) {
-		$synt = $synt->{$arg};
-	    } elsif (exists($synt->{'*'})) {
-		$synt = $synt->{'*'};
-	    } else {
-		croak "no such component in syntax: $arg";
-	    }
-	}
 
-	if (@_ == 1) {
-	    my $v = shift;
-	    if ($synt && ref($synt) eq 'HASH') {
-		if ($synt->{array}) {
-		    if (exists($ref->{$arg})) {
-			$v = [ @{$ref->{$arg}}, $v ];
-		    } else {
-			$v = [ $v ];
-		    }
-		}
-	    }
-	    $ref->{$arg} = $v;
-	    return;
-	}
+1;
+__DATA__
+[core]
+    postrenew = STRING :array
+    rootdir = STRING :default=/var/www/acme
+    files = STRING
+    time-delta = NUMBER :default=86400
+    source = STRING :default=apache :array
+    check-alt-names = STRING :default=0 :check=check_bool
+    check-dns = STRING :default=1 :check=check_bool
+    my-ip = STRING :array
+    key-size = NUMBER :default=4096
+[files ANY]
+    type = STRING :re="^(single|split)$"
+    certificate-file = STRING
+    key-file = STRING
+    ca-file = STRING
+    argument = STRING
+[domain ANY]
+    alt = STRING :array
+    files = STRING
+    key-size = NUMBER
+    postrenew = STRING
 
-	if ($synt) {
-	    croak "component not a section: $arg"
-		unless $synt->{section};
-	    $synt = $synt->{section};
-	}
-	$ref->{$arg} = {} unless exists $ref->{$arg};
-	$ref = $ref->{$arg};
-    }
-}
+    
 
-1;
 
     
diff --git a/lib/App/Acmeman/Source/File.pm b/lib/App/Acmeman/Source/File.pm
index 0d6859d..9414e86 100644
--- a/lib/App/Acmeman/Source/File.pm
+++ b/lib/App/Acmeman/Source/File.pm
@@ -50,12 +50,14 @@ sub load {
         };
     chomp(my @lines = <$fh>);
     close $fh;
-    if ($self->{host}) {
-	$self->define_alias($self->{host}, @lines);
-    } else {
-	my $cn = shift @lines;
-	$self->define_domain($cn);
-	$self->define_alias($cn, @lines);
+    if (@lines) {
+	if ($self->{host}) {
+	    $self->define_alias($self->{host}, @lines);
+        } else {
+	    my $cn = shift @lines;
+	    $self->define_domain($cn);
+	    $self->define_alias($cn, @lines);
+	}
     }
     return 1;
 }
-- 
cgit v1.2.1