#!/usr/bin/perl use v5.40; use List::Util qw(any uniq pairmap); use Getopt::Long qw(:config posix_default bundling_values no_ignorecase); use Cwd qw(realpath); use Errno qw(EEXIST); use File::Basename; use File::Path qw(make_path); use File::Copy qw(mv); use File::Find; use Time::Piece; use Fcntl; use POSIX qw(:sys_wait_h); use Hash::Merge qw(merge); use YAML::XS qw(LoadFile); use NGCP::Template; my $DEBUG = $ENV{DEBUG} || 0; my $HNAME = $ENV{HNAME} // ''; my $TIME_FORMAT = $ENV{TIME_FORMAT} // '%F %T'; $TIME_FORMAT =~ s/^\+//; my $NGCPCTL_MAIN = $ENV{NGCPCTL_MAIN}; my $TEMPLATE_POOL_BASE = $ENV{TEMPLATE_POOL_BASE}; my $SITES_DIR = $ENV{SITES_DIR} // "$NGCPCTL_MAIN/sites"; my $SITES_CONFIG = $ENV{SITES_CONFIG} // "$NGCPCTL_MAIN/sites.yml"; my $CONFIG_POOL = $ENV{CONFIG_POOL} // ''; my %options = ( help => sub { usage(); exit 0; }, jobs => qx(nproc) // 1, ); chomp $options{jobs}; error("NGCPCTL_MAIN is not defined") unless $NGCPCTL_MAIN; error("SITES_DIR is not defined") unless $SITES_DIR; error("SITES_CONFIG is not defined") unless $SITES_CONFIG; error("TEMPLATE_POOL_BASE is not defined") unless $TEMPLATE_POOL_BASE; GetOptions(\%options, 'help|?', 'quiet|q', 'pairs|p', 'jobs|j:i', 'config|c=s@', 'replace|r=s', ); if (exists $options{pairs} && @ARGV % 2 != 0) { error("--pairs requires argument pairs"); } if(exists $options{replace}) { my ($orig, $dest) = split /:/, $options{replace}; $options{replace} = { orig => $orig, dest => $dest }; debug("replace orig:$orig dest:$dest"); } setup(); exit process(%options); sub usage { print <...] ... Options: -c, --config List of comma-separated config YAML files. Option can appear multiple times. -j, --jobs [] Use up to processing jobs (defaults to nproc). Missing argument means no limit of jobs. -p, --pairs Expect the arguments to be pairs. -r, --replace Replace path with for output. -q, --quiet Do not print progress information. -h, --help This help message. HELP } sub output_prefix { my $t = Time::Piece->new; my $timestamp = $t->strftime($TIME_FORMAT); return "$timestamp $HNAME"; } sub error { my $prefix = output_prefix(); die "$prefix: Error: @_\n"; } sub warning { my $prefix = output_prefix(); warn "$prefix: Warning: @_\n"; } sub info { return if $options{quiet}; my $prefix = output_prefix(); print "$prefix: @_\n"; } sub debug { return unless $DEBUG; my $prefix = output_prefix(); warn "$prefix: DEBUG @_\n"; } sub setup { my $NGCP_BASE_TT2 = $ENV{'NGCP_BASE_TT2'} //= '/'; chdir $NGCP_BASE_TT2 or error("Cannot chdir to $NGCP_BASE_TT2: $!"); } sub process_template { my ($tt, $config, $input, $output) = @_; # permissions should be set based on the "base file", since derived files # .customtt.tt2 or .customtt.tt2.web01a often have been created or copied # without the right permissions, whereas the base file usually has the right # permissions (at least if unmodified since shipped from the .deb file) my $input_for_perms = $input; $input_for_perms =~ s/\.customtt\.tt2/.tt2/ig; $input_for_perms =~ s/\.tt2.*/.tt2/ig; if (! -e $input_for_perms) { warn("base filename:${input_for_perms} for:${input} not found\n"); } # Set permissions for generated config based on the ones of the # template, plus dropping all write permissions. my $old_umask = umask 0222; # base file does not exist, default perms ## no critic (ValuesAndExpressions::ProhibitLeadingZeros) my $mode = (stat $input_for_perms)[2] // 0644; my $newfile = "$output.ngcpcfg-new"; my $outfh; if (!sysopen $outfh, $newfile, O_CREAT | O_EXCL | O_WRONLY, $mode) { if ($! != EEXIST) { error("Cannot open template new file $newfile: $!"); } unlink $newfile or error("Cannot remove template new file $newfile: $!"); sysopen $outfh, $newfile, O_CREAT | O_EXCL | O_WRONLY, $mode or error("Cannot open template new file $newfile: $!"); } binmode $outfh, ':encoding(UTF-8)'; open my $infh, '<:encoding(UTF-8)', $input or error("Cannot open file '$input' for reading: $!"); $tt->process($infh, $config, $outfh) or error("Cannot process template '$input':\n " . $tt->error()); close $infh; close $outfh; # Restore previous umask. umask $old_umask; # XXX: Docker breaks sane Unix expectations when moving a file into # /etc/hosts, as it creates a bind mount on that pathname. We need to # use an implementation that will fallback to use copy semantics in # that case, but will default to use rename semantics to avoid races # on ETXTBSY on executable files. # # # In addition we need to dereference any target symlink, so that we do # not destroy any symlink pointing to the real file. my $target = realpath($output); mv($newfile, $target) or error("Cannot rename $newfile to $target: $!"); } sub run_hook { my ($hook, $file) = @_; return unless exists $file->{$hook}; # Export variable for usage within hook scripts. local $ENV{output_file} = $file->{output}; # Execute hook script. info("Executing $file->{$hook} for $file->{output}"); system("bash $file->{$hook}") == 0 or error("Execution of $hook script '$file->{$hook}' failed: $?"); } sub process_input { my ($tt, $config, $file) = @_; my $input = $file->{input}; my $output = $file->{output}; # Ensure we do not try to generate a file where a directory with same # name exists already. if (-d $output) { error("Generating file $output not possible, it's an existing directory."); } # Execute prebuild script. run_hook('prebuild', $file); # If output directory does not exist yet, create it my $output_dirname = dirname($output); if (not -d $output_dirname) { ## no critic (ValuesAndExpressions::ProhibitLeadingZeros) make_path($output_dirname, { mode => 0755 }); } # Assume safe defaults. umask 0077; try { process_template($tt, $config, $input, $output); info("Generating $output: OK"); } catch ($e) { warn $e; error("Generating $output based on $input: FAILED"); } # Execute postbuild script. run_hook('postbuild', $file); } sub get_output_path { my $file = shift; my $output = ($file =~ s{\Q$NGCPCTL_MAIN\E/templates}{}r); if(exists $options{replace}) { my $orig = $options{replace}->{orig}; my $dest = $options{replace}->{dest}; $output = ($output =~ s{\Q$orig\E}{$dest}r); } # Add OUTPUT_DIRECTORY for customization during testing. if (length $ENV{OUTPUT_DIRECTORY}) { $output = "$ENV{OUTPUT_DIRECTORY}$output"; } return $output; } sub generate_iofiles { debug("Generating template file list from '$CONFIG_POOL'"); if (exists $options{pairs}) { return [ pairmap { { input => $a, output => $b, } } @ARGV ]; } # Support for PRO/CARRIER systems. my @tt2_hosts; foreach my $name (qw(HOST_FILE PAIR_FILE NODE_FILE)) { push @tt2_hosts, $ENV{$name} if defined $ENV{$name}; } @tt2_hosts = uniq(@tt2_hosts); # Scan all directories. my @scan_dirs; foreach my $dir (split ' ', $CONFIG_POOL) { if (! -d $dir) { warning("$dir does not exist"); next; } debug("Scanning $TEMPLATE_POOL_BASE$dir"); push @scan_dirs, "$TEMPLATE_POOL_BASE$dir"; } return if @scan_dirs == 0; # Scan all template files within the directories. my %filenames_scan; my $scan_regex = "(?:\.customtt)?\.tt2"; my $scan_host_regex; foreach my $part (@tt2_hosts) { $scan_host_regex .= "|\Q$part\E"; } $scan_regex .= "(?:$scan_host_regex)?" if defined $scan_host_regex; debug("Scan regex $scan_regex"); my $scan_tt2 = sub { # Ignoring foo.patchtt.tt2.* completely (it is not a tt2 template to # be built). if (m/.*\.patchtt\.tt2(?:.*)?$/) { debug("Ignored patchtt file '$_'"); return; } my $output = $File::Find::name; if ($output !~ s/$scan_regex$//) { return; } # Argument(s) (file list/pattern) provided via cmdline. my $match = @ARGV == 0 ? 1 : any { $output =~ m/$_/ } @ARGV; if ($match) { debug("Filename matched $File::Find::name => $output"); $filenames_scan{$output}{$File::Find::name} = 1; } }; find({ wanted => $scan_tt2, follow_skip => 2, no_chdir => 1, }, @scan_dirs); # Prepare the list of variant extension in order: my @match_ext; # foo.customtt.tt2.{instname,hostname,pairname,spX} > push @match_ext, ".customtt.tt2$_" foreach (@tt2_hosts); # foo.customtt.tt2 > push @match_ext, ".customtt.tt2"; # foo.tt2.{instname,hostname,pairname,spX} > push @match_ext, ".tt2$_" foreach (@tt2_hosts); # foo.tt2 push @match_ext, ".tt2"; # Generate the output file list. Make sure we provide the file names just # once, and special case the ngcp-service files, as they are a second # stage source of data required during configuration file building, which # depends at the same time on the main YAML files. my @filenames_prio; my @filenames_norm; my %filenames; foreach my $file (keys %filenames_scan) { # Select the preferred filename. foreach my $ext (@match_ext) { if (exists $filenames_scan{$file}{"$file$ext"}) { my $input = "$file$ext"; my $output = get_output_path $file; if ($file =~ m/ngcp-service/) { push @filenames_prio, $input; } else { push @filenames_norm, $input; } $filenames{$input} = { input => $input, output => $output, }; # Select prebuild and postbuild scripts. my $input_dirname = dirname($input); my $output_basename = basename($output); foreach my $hook (qw(prebuild postbuild)) { foreach my $hookfile (( "$input_dirname/$output_basename.$hook", "$input_dirname/ngcpcfg.$hook")) { next unless -e $hookfile; $filenames{$input}{$hook} = $hookfile; } } last; } } } my @filenames = map { $filenames{$_} } (sort(@filenames_prio), sort(@filenames_norm)); return \@filenames; } sub proc_pool_runner { my ($code, $filelist) = @_; my $nprocs = 0; my $rc = 0; foreach my $file (@{$filelist}) { my $pid = fork; if (not defined $pid) { error("Cannot fork child process to process $file->{input}: $!"); } if ($pid != 0) { # We are the parent. $nprocs++; # If we have queued enough work, wait for some to finish. if ($options{jobs} > 0 && $nprocs >= $options{jobs}) { my $kid = waitpid(-1, 0); $nprocs-- if $kid > 0; $rc = 1 if $kid > 0 && $? != 0; } # Queue more work if available. next; } $code->($file); exit 0; } # Reap any remaining zombies. while (1) { my $pid = waitpid(-1, 0); last if $pid < 0; $nprocs--; $rc = 1 if $? != 0; } if ($nprocs != 0) { warning("queued or reaped more jobs than expected, remaining $nprocs"); } return $rc; } sub merge_yml { my ($config, $file) = @_; state %loaded_ymls = (); return $config if exists $loaded_ymls{$file}; $loaded_ymls{$file} = undef; return $config if not -f $file; my $prefix = output_prefix(); print "$prefix: Loading $file in memory:" unless $options{quiet}; my $hm = Hash::Merge->new('RIGHT_PRECEDENT'); $config = $hm->merge($config, LoadFile($file)); print " OK \n" unless $options{quiet}; return $config; } sub process { my %options = @_; my $config = {}; my $sites = {}; my $visible_jobs = $options{jobs} || 'unlimited'; info("Building configurations with $visible_jobs concurrent jobs"); if (-f $SITES_CONFIG) { if (-d $SITES_DIR && -l "$SITES_DIR/current") { $sites = LoadFile($SITES_CONFIG); } else { warning("found $SITES_CONFIG config file but no $SITES_DIR/current symlink; " . "will not load the config"); } } $sites->{sites_enable} //= 'no'; if ($sites->{sites_enable} eq 'yes') { info("Loading in multi-site mode"); my $current_site = readlink "$SITES_DIR/current"; if (not defined $current_site) { error("Cannot read symlink target for $SITES_DIR/current: $!"); } info("Current site is '$current_site'"); if (not exists $sites->{sites}{$current_site}) { error("Cannot find current site $current_site in sites definitions."); } foreach my $site (sort keys %{$sites->{sites}}) { foreach my $file (@{$options{config}}) { my $site_file = "$SITES_DIR/$site/" . basename($file); $sites->{sites}{$site} = merge_yml($sites->{sites}{$site}, $site_file); } } # First fill the root config with the current site. $config = $sites->{sites}{$current_site}; # Then fill the sites sub-trees. foreach my $site (sort keys %{$sites->{sites}}) { $config->{sites}{$site} = $sites->{sites}{$site}; } # Create the 'current' reference. $config->{sites}{current} = $config->{sites}{$current_site}; } else { info("Loading in single-site mode"); foreach my $file (@{$options{config}}) { $sites = merge_yml($sites, $file); } # First fill the root config with the current site. $config = $sites; # Create the 'current' site reference for compatibility. $config->{sites}{current} = $sites; } $config->{sites_enable} = $sites->{sites_enable}; my $tt = NGCP::Template->new(); my $rc; $rc = proc_pool_runner(sub { my $file = shift; process_input($tt, $config, $file); }, generate_iofiles()); return $rc; }