diff options
Diffstat (limited to 'knetworkconf/backends/replace.pl.in')
| -rw-r--r-- | knetworkconf/backends/replace.pl.in | 1770 |
1 files changed, 1770 insertions, 0 deletions
diff --git a/knetworkconf/backends/replace.pl.in b/knetworkconf/backends/replace.pl.in new file mode 100644 index 0000000..a72e3ef --- /dev/null +++ b/knetworkconf/backends/replace.pl.in @@ -0,0 +1,1770 @@ +#!/usr/bin/env perl +#-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- + +# replace.pl: Common in-line replacing stuff for the ximian-setup-tools backends. +# +# Copyright (C) 2000-2001 Ximian, Inc. +# +# Authors: Hans Petter Jansson <hpj@ximian.com> +# Arturo Espinosa <arturo@ximian.com> +# Michael Vogt <mvo@debian.org> - Debian 2.[2|3] support. +# David Lee Ludwig <davidl@wpi.edu> - Debian 2.[2|3] support. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU Library General Public License as published +# by the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Library General Public License for more details. +# +# You should have received a copy of the GNU Library General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + + +$SCRIPTSDIR = "@scriptsdir@"; +if ($SCRIPTSDIR =~ /^@scriptsdir[@]/) +{ + $SCRIPTSDIR = "."; + $DOTIN = ".in"; +} + +require "$SCRIPTSDIR/util.pl$DOTIN"; +require "$SCRIPTSDIR/file.pl$DOTIN"; +require "$SCRIPTSDIR/parse.pl$DOTIN"; + + +# General rules: all replacing is in-line. Respect unsupported values, comments +# and as many spacing as possible. + +# The concept of keyword (kw) here is a key, normaly in its own line, whose +# boolean representation is its own existence. + +# A $re is a regular expression. In most functions here, regular expressions +# are converted to simple separators, by using gst_replace_regexp_to_separator. +# This makes it easier to convert a parse table into a replace table. + +# Every final replacing function to be used by a table must handle one key +# at a time, but may replace several values from there. +# +# Return 0 for success, and -1 for failure. +# +# Most of these functions have a parsing counterpart. The convention is +# that parse becomes replace and split becomes join: +# gst_parse_split_first_str -> gst_replace_join_first_str + +# Additional abstraction: replace table entries can have +# arrays inside. The replace proc will be ran with every +# combination that the arrays provide. Ex: +# ["user", \&gst_replace_foo, [0, 1], [2, 3] ] will replace +# using all possibilities in the combinatory of [0, 1]x[2, 3]. +# Check RedHat 7.2's network replace table for further +# enlightenment. +sub gst_replace_run_entry +{ + my ($values_hash, $key, $proc, $cp, $value) = @_; + my ($ncp, $i, $j, $res); + + $ncp = [@$cp]; + for ($i = 0; $i < scalar (@$cp); $i ++) + { + if (ref $$cp[$i] eq "ARRAY") + { + foreach $j (@{$$cp[$i]}) + { + $$ncp[$i] = $j; + $res = -1 if &gst_replace_run_entry ($values_hash, $key, $proc, $ncp, $value); + } + return $res; + } + } + + # OK, the given entry didn't have any array refs in it... + + &gst_debug_print_line ("gst_replace_from_table: $key"); + return -1 if (!&gst_parse_replace_hash_values ($ncp, $values_hash)); + push (@$ncp, $$values_hash{$key}) unless $key eq "_always_"; + $res = -1 if &$proc (@$ncp); + return $res; +} + +# gst_replace_from_table takes a file mapping, a replace table, a hash +# of values, probably made from XML parsing, and whose keys are +# the same keys the table handles. +# +# Table entries whose keys are not present in the values_hash +# will not be processed. More than one entry may process the same key. +# +# The functions in the replace tables, most of which are coded in +# this file, receive the mapped files of the first argument, and then +# a set of values. The last argument is the value of the $values_hash +# for the corresponding key of the entry. +sub gst_replace_from_table +{ + my ($fn, $table, $values_hash, $old_hash) = @_; + my ($key, $proc, @param); + my ($i, @cp, @files, $res); + + $$fn{"OLD_HASH"} = $old_hash; + + foreach $i (@$table) + { + @cp = @$i; + $key = shift (@cp); + + $proc = shift (@cp); + @files = &gst_parse_replace_files (shift (@cp), $fn); + unshift @cp, @files if (scalar @files) > 0; + + if ((exists $$values_hash{$key}) or ($key eq "_always_")) + { + $res = &gst_replace_run_entry ($values_hash, $key, $proc, \@cp, $$values_hash{$key}); + } + elsif ((!exists $$values_hash{$key}) && (exists $$old_hash{$key})) + { + # we need to remove all the instances of the known variables that doesn't exist in the XML + $res = &gst_replace_run_entry ($values_hash, $key, $proc, \@cp, undef); + } + } + + return $res; +} + +# Wacky function that tries to create a field separator from a regular expression. +# Doesn't work with all possible regular expressions: just with the ones we are working with. +sub gst_replace_regexp_to_separator +{ + $_ = $_[0]; + + s/\[([^^])([^\]])[^\]]*\]/$1/g; + s/\+//g; + s/\$//g; + s/[^\*]\*//g; + + return $_; +} + +sub is_array_ref +{ + my $val; + + return 1 if (ref ($val) eq "ARRAY"); + return 0 if (ref ($val) eq undef); + + &gst_debug_print_line ("is_array_ref: We shouldn't be here!"); + + return 0; +} + +sub set_value +{ + my ($key, $val, $re) = @_; + + return $key . &gst_replace_regexp_to_separator ($re) . $val; +} + +# Edit a $file, wich is assumed to have a column-based format, with $re matching field separators +# and one record per line. Search for lines with the corresponding $key. +# The last arguments can be any number of standard strings. +sub gst_replace_split +{ + my ($file, $key, $re, @value) = @_; + my ($fd, @line, @res); + my ($buff, $i); + my ($pre_space, $post_comment); + my ($line_key, $val, $ret); + + &gst_report_enter (); + &gst_report ("replace_split", $key, $file); + + $buff = &gst_file_buffer_load ($file); + + foreach $i (@$buff) + { + $pre_space = $post_comment = ""; + + chomp $i; + $pre_space = $1 if $i =~ s/^([ \t]+)//; + $post_comment = $1 if $i =~ s/([ \t]*\#.*)//; + + if ($i ne "") + { + @line = split ($re, $i, 2); + $line_key = shift (@line); + + # found the key? + if ($line_key eq $key) + { + shift (@value) while ($value[0] eq "" && (scalar @value) > 0); + + if ((scalar @value) == 0) + { + $i = ""; + next; + } + + $val = shift (@value); + + chomp $val; + $i = &set_value ($key, $val, $re); + } + } + + $i = $pre_space . $i . $post_comment . "\n"; + } + + foreach $i (@value) + { + push (@$buff, &set_value ($key, $i, $re) . "\n") if ($i ne ""); + } + + &gst_file_buffer_clean ($buff); + $ret = &gst_file_buffer_save ($buff, $file); + &gst_report_leave (); + return $ret; +} + +# Replace all key/values in file with those in @$value, +# deleting exceeding ones and appending those required. +sub gst_replace_join_all +{ + my ($file, $key, $re, $value) = @_; + + return &gst_replace_split ($file, $key, $re, @$value); +} + +# Find first $key value and replace with $value. Append if not found. +sub gst_replace_join_first_str +{ + my ($file, $key, $re, $value) = @_; + + return &gst_replace_split ($file, $key, $re, $value); +} + +# Treat value as a bool value, using val_off and val_on as corresponding +# boolean representations. +sub gst_replace_join_first_bool +{ + my ($file, $key, $re, $val_on, $val_off, $value) = @_; + + # Fixme: on and off should be a parameter. + $value = ($value == 1)? $val_on: $val_off; + + return &gst_replace_split ($file, $key, $re, $value); +} + +# Find first key in file, and set array join as value. +sub gst_replace_join_first_array +{ + my ($file, $key, $re1, $re2, $value) = @_; + + return &gst_replace_split ($file, $key, $re1, join (&gst_replace_regexp_to_separator ($re2), @$value)); +} + +# Escape $value in /bin/sh way, find/append key and set escaped value. +sub gst_replace_sh +{ + my ($file, $key, $value) = @_; + my $ret; + + $value = &gst_parse_shell_escape ($value); + + &gst_report_enter (); + &gst_report ("replace_sh", $key, $file); + + # This will expunge the whole var if the value is empty. + if ($value eq "") + { + $ret = &gst_replace_split ($file, $key, "[ \t]*=[ \t]*"); + } + else + { + $ret = &gst_replace_split ($file, $key, "[ \t]*=[ \t]*", $value); + } + + &gst_report_leave (); + return $ret; +} + +# Escape $value in /bin/sh way, find/append key and set escaped value, make sure line har +sub gst_replace_sh_export +{ + my ($file, $key, $value) = @_; + my $ret; + + $value = &gst_parse_shell_escape ($value); + + # This will expunge the whole var if the value is empty. + + # FIXME: Just adding "export " works for the case I need, though it doesn't + # handle arbitraty whitespace. Something should be written to replace gst_replace_split() + # here. + + if ($value eq "") + { + $ret = &gst_replace_split ($file, "export " . $key, "[ \t]*=[ \t]*"); + } + else + { + $ret = &gst_replace_split ($file, "export " . $key, "[ \t]*=[ \t]*", $value); + } + + return $ret; +} + +# Treat value as a yes/no bool, replace in shell style. +# val_true and val_false have default yes/no values. +# use &gst_replace_sh_bool (file, key, value) if defaults are desired. +sub gst_replace_sh_bool +{ + my ($file, $key, $val_true, $val_false, $value) = @_; + + # default value magic. + if ($val_false eq undef) + { + $value = $val_true; + $val_true = undef; + } + + $val_true = "yes" unless $val_true; + $val_false = "no" unless $val_false; + + $value = ($value == 1)? $val_true: $val_false; + + return &gst_replace_sh ($file, $key, $value); +} + +# Treat value as a yes/no bool, replace in export... shell style. +sub gst_replace_sh_export_bool +{ + my ($file, $key, $val_true, $val_false, $value) = @_; + + # default value magic. + if ($val_false eq undef) + { + $value = $val_true; + $val_true = undef; + } + + $val_true = "yes" unless $val_true; + $val_false = "no" unless $val_false; + + $value = ($value == 1)? $val_true: $val_false; + + return &gst_replace_sh_export ($file, $key, $value); +} + +# Get a fully qualified hostname from a $key shell var in $file +# and set the hostname part. e.g.: suse70's /etc/rc.config's FQHOSTNAME. +sub gst_replace_sh_set_hostname +{ + my ($file, $key, $value) = @_; + my ($domain); + + $domain = &gst_parse_sh_get_domain ($file, $key); + return &gst_replace_sh ($file, $key, "$value.$domain"); +} + +# Get a fully qualified hostname from a $key shell var in $file +# and set the domain part. e.g.: suse70's /etc/rc.config's FQHOSTNAME. +sub gst_replace_sh_set_domain +{ + my ($file, $key, $value) = @_; + my ($hostname); + + $hostname = &gst_parse_sh_get_hostname ($file, $key); + return &gst_replace_sh ($file, $key, "$hostname.$value"); +} + +# Join the array pointed by $value with the corresponding $re separator +# and assign that to the $key shell variable in $file. +sub gst_replace_sh_join +{ + my ($file, $key, $re, $value) = @_; + + return &gst_replace_sh ($file, $key, + join (&gst_replace_regexp_to_separator ($re), @$value)); +} + +# replace a regexp with $value +sub gst_replace_sh_re +{ + my ($file, $key, $re, $value) = @_; + my ($val); + + $val = &gst_parse_sh ($file, $key); + + if ($val =~ /$re/) + { + $val =~ s/$re/$value/; + } + else + { + $val .= $value; + } + + $val = '"' . $val . '"' if ($val !~ /^\".*\"$/); + + return &gst_replace_split ($file, $key, "[ \t]*=[ \t]*", $val) +} + +# Quick trick to set a keyword $key in $file. (think /etc/lilo.conf keywords). +sub gst_replace_kw +{ + my ($file, $key, $value) = @_; + my $ret; + + &gst_report_enter (); + &gst_report ("replace_kw", $key, $file); + $ret = &gst_replace_split ($file, $key, "\$", ($value)? "\n" : ""); + &gst_report_leave (); + return $ret; +} + +# The kind of $file whose $value is its first line contents. +# (/etc/hostname) +sub gst_replace_line_first +{ + my ($file, $value) = @_; + my $fd; + + &gst_report_enter (); + &gst_report ("replace_line_first", $file); + $fd = &gst_file_open_write_from_names ($file); + &gst_report_leave (); + return -1 if !$fd; + + print $fd "$value\n"; + &gst_file_close ($fd); + + return 0; +} + +# For every key in %$value, replace/append the corresponding key/value pair. +# The separator for $re1 +sub gst_replace_join_hash +{ + my ($file, $re1, $re2, $value) = @_; + my ($i, $res, $tmp, $val); + my ($oldhash, %merge); + + $oldhash = &gst_parse_split_hash ($file, $re1, $re2); + foreach $i (keys (%$value), keys (%$oldhash)) + { + $merge{$i} = 1; + } + + $res = 0; + + foreach $i (keys (%merge)) + { + if (exists $$value{$i}) + { + $val = join (&gst_replace_regexp_to_separator ($re2), @{$$value{$i}}); + $tmp = &gst_replace_split ($file, $i, $re1, $val); + } + else + { + # This deletes the entry. + $tmp = &gst_replace_split ($file, $i, $re1); + } + $res = $tmp if !$res; + } + + return $res; +} + +# Find $re matching send string and replace parenthesyzed +# part of $re with $value. FIXME: apply meeks' more general impl. +sub gst_replace_chat +{ + my ($file, $re, $value) = @_; + my ($buff, $i, $bak, $found, $substr, $ret); + + &gst_report_enter (); + &gst_report ("replace_chat", $file); + $buff = &gst_file_buffer_load ($file); + + SCAN: foreach $i (@$buff) + { + $bak = ""; + $found = ""; + my ($quoted); + chomp $i; + + while ($i ne "") + { + # If it uses quotes. FIXME: Assuming they surround the whole string. + if ($i =~ /^\'/) + { + $i =~ s/\'([^\']*)\' ?//; + $found = $1; + $quoted = 1; + } + else + { + $i =~ s/([^ \t]*) ?//; + $found = $1; + $quoted = 0; + } + + # If it looks like what we're looking for, + # substitute what is in parens with value. + if ($found =~ /$re/i) + { + $substr = $1; + $found =~ s/$substr/$value/i; + + if ($quoted == 1) + { + $i = $bak . "\'$found\' " . $i . "\n"; + } + else + { + $i = $bak . "$found " . $i . "\n"; + } + + last SCAN; + } + + if ($quoted == 1) + { + $bak .= "\'$found\'"; + } + else + { + $bak .= "$found"; + } + + $bak .= " " if $bak ne ""; + } + + $i = $bak . "\n"; + } + + $ret = &gst_file_buffer_save ($buff, $file); + &gst_report_leave (); + return $ret; +} + +# Find/append $section in ini $file and replace/append +# $var = $value pair. FIXME: should reimplement with +# interfaces style. This is too large. +sub gst_replace_ini +{ + my ($file, $section, $var, $value) = @_; + my ($buff, $i, $found_flag, $ret); + my ($pre_space, $post_comment, $sec_save); + + &gst_report_enter (); + &gst_report ("replace_ini", $var, $section, $file); + + $buff = &gst_file_buffer_load ($file); + + &gst_file_buffer_join_lines ($buff); + $found_flag = 0; + + foreach $i (@$buff) + { + $pre_space = $post_comment = ""; + + chomp $i; + $pre_space = $1 if $i =~ s/^([ \t]+)//; + $post_comment = $1 if $i =~ s/([ \t]*[\#;].*)//; + + if ($i ne "") + { + if ($i =~ /\[$section\]/i) + { + $i =~ s/(\[$section\][ \t]*)//i; + $sec_save = $1; + $found_flag = 1; + } + + if ($found_flag) + { + if ($i =~ /\[[^\]]+\]/) + { + $i = "$var = $value\n$i" if ($value ne ""); + $found_flag = 2; + } + + if ($i =~ /^$var[ \t]*=/i) + { + if ($value ne "") + { + $i =~ s/^($var[ \t]*=[ \t]*).*/$1$value/i; + } + else + { + $i = ""; + } + $found_flag = 2; + } + } + } + + if ($found_flag && $sec_save ne "") + { + $i = $sec_save . $i; + $sec_save = ""; + } + + $i = $pre_space . $i . $post_comment . "\n"; + last if $found_flag == 2; + } + + push @$buff, "\n[$section]\n" if (!$found_flag); + push @$buff, "$var = $value\n" if ($found_flag < 2 && $value ne ""); + + &gst_file_buffer_clean ($buff); + $ret = &gst_file_buffer_save ($buff, $file); + &gst_report_leave (); + return $ret; +} + +# Well, removes a $section from an ini type $file. +sub gst_replace_remove_ini_section +{ + my ($file, $section) = @_; + my ($buff, $i, $found_flag, $ret); + my ($pre_space, $post_comment, $sec_save); + + &gst_report_enter (); + &gst_report ("replace_del_ini_sect", $section, $file); + + $buff = &gst_file_buffer_load ($file); + + &gst_file_buffer_join_lines ($buff); + $found_flag = 0; + + foreach $i (@$buff) + { + $pre_space = $post_comment = ""; + + chomp $i; + $pre_space = $1 if $i =~ s/^([ \t]+)//; + $post_comment = $1 if $i =~ s/([ \t]*[\#;].*)//; + + if ($i ne "") + { + if ($i =~ /\[$section\]/i) + { + $i =~ s/(\[$section\][ \t]*)//i; + $found_flag = 1; + } + elsif ($found_flag && $i =~ /\[.+\]/i) + { + $i = $pre_space . $i . $post_comment . "\n"; + last; + } + } + + if ($found_flag) + { + if ($post_comment =~ /^[ \t]*$/) + { + $i = ""; + } + else + { + $i = $post_comment . "\n"; + } + } + else + { + $i = $pre_space . $i . $post_comment . "\n"; + } + } + + &gst_file_buffer_clean ($buff); + $ret = &gst_file_buffer_save ($buff, $file); + &gst_report_leave (); + return $ret; +} + +# Removes a $var in $section of a ini type $file. +sub gst_replace_remove_ini_var +{ + my ($file, $section, $var) = @_; + &gst_replace_ini ($file, $section, $var, ""); +} + +# Replace using boolean $value with a yes/no representation, +# ini style. +sub gst_replace_ini_bool +{ + my ($file, $section, $var, $value) = @_; + + $value = ($value == 1)? "yes": "no"; + + return &gst_replace_ini ($file, $section, $var, $value); +} + +# *cap replacement methods. +#sub gst_replace_cap +#{ +# my ($file, $section, $var, $value) = @_; +# my ($buff, $i, $found_flag, $ret); +# my ($pre_space, $post_comment, $sec_save); +# +# $buff = &gst_file_buffer_load ($file); +## &gst_file_buffer_join_lines ($buff); +# $found_flag = 0; +# +# foreach $i (@$buff) +# { +# $pre_space = $post_comment = ""; +# +# chomp $i; +# $pre_space = $1 if $i =~ s/^([ \t]+)//; +# $post_comment = $1 if $i =~ s/^([ \t]*[\#].*)//; +# +# if ($i ne "") +# { +# if ($i =~ /^$section[|:]/i) +# { +# $i =~ s/^($section)//i; +# $sec_save = $1; +# $found_flag = 1; +# } +# +# if ($found_flag) +# { +# if ($i =~ /^[a-z0-9]+[|:]/) +# { +# $i = "\t:$var=$value:\n$i"; +# $found_flag = 2; +# } +# +# if ($found_flag && $i =~ /^:$var[=:]/i) +# { +# if ($value ne "") +# { +# $i =~ s/^(:$var)[^:]*/$1=$value/i; +# } +# else +# { +# $i = ""; +# } +# $found_flag = 2; +# } +# } +# } +# +# if ($found_flag && $sec_save ne "") +# { +# $i = $sec_save . $i; +# $sec_save = ""; +# } +# +# $i = $pre_space . $i . $post_comment . "\n"; +# last if $found_flag == 2; +# } +# +# push @$buff, "\n$section:\\\n" if (!$found_flag); +# push @$buff, "\t:$var=$value:\n" if ($found_flag < 2 && $value ne ""); +# +# &gst_file_buffer_clean ($buff); +# $ret = &gst_file_buffer_save ($buff, $file); +# return $ret; +#} + +sub gst_replace_remove_cap_section +{ + my ($file, $section) = @_; + my ($buff, $i, $found_flag, $ret); + my ($pre_space, $post_comment, $sec_save); + + $buff = &gst_file_buffer_load ($file); + $found_flag = 0; + + foreach $i (@$buff) + { + $pre_space = $post_comment = ""; + + chomp $i; + $pre_space = $1 if $i =~ s/^([ \t]+)//; + $post_comment = $1 if $i =~ s/^([ \t]*[\#].*)//; + + if ($i ne "") + { + if ($i =~ /^$section[|:]/i) + { + $i = ""; + $found_flag = 1; + } + elsif ($found_flag && $i =~ /^[a-z0-9]+[|:]/i) + { + $i = $pre_space . $i . $post_comment . "\n"; + last; + } + } + + if ($found_flag) + { + if ($post_comment =~ /^[ \t]*$/) + { + $i = ""; + } + else + { + $i = $post_comment . "\n"; + } + } + else + { + $i = $pre_space . $i . $post_comment . "\n"; + } + } + + &gst_file_buffer_clean ($buff); + $ret = &gst_file_buffer_save ($buff, $file); + return $ret; +} + +# Save a printcap buffer to file. This doesn't do any extra processing for now, +# but it may do so in the future. +sub gst_replace_printcap_buffer_save +{ + my ($file, $buf) = @_; + my $ret; + + &gst_file_buffer_clean ($buf); + $ret = &gst_file_buffer_save ($buf, $file); + return $ret; +} + +sub gst_replace_printcap_print_stanza +{ + my ($stanza) = @_; + return $stanza . ":\n"; +} + +sub gst_replace_printcap_print_option +{ + my ($option, $type, $value) = @_; + return "\t:" . $option . $type . $value . ":\n"; +} + +sub gst_replace_printcap_add_stanza +{ + my ($buf, $stanza) = @_; + + push @$buf, "\n"; + push @$buf, "##PRINTTOOL3## LOCAL unknown NAxNA {} Unknown Default {}\n"; + push @$buf, &gst_replace_printcap_print_stanza ($stanza); + + return ($#$buf - 1, $#$buf); +} + +sub gst_replace_printcap_add_option_slot +{ + my ($buf, $stanza_line_no) = @_; + my (@buf_tail); + + @buf_tail = splice (@$buf, $stanza_line_no + 1); + push @$buf, "\t:NEW_OPTION:\n"; + push @$buf, @buf_tail; + + return $stanza_line_no + 1; +} + +sub gst_replace_printcap_remove_stanza_from_buf +{ + my ($buf, $printtool_line_no, $stanza_line_no) = @_; + my ($next_printtool_line_no, $next_stanza_line_no); + my ($splice_start, $splice_end); + + ($next_printtool_line_no, $next_stanza_line_no) = + &gst_parse_printcap_get_next_stanza ($buf, $stanza_line_no + 1); + + if ($printtool_line_no != -1) + { + $splice_start = $printtool_line_no; + } + else + { + $splice_start = $stanza_line_no; + } + + if ($next_printtool_line_no != -1) + { + $splice_end = $next_printtool_line_no; + } + else + { + $splice_end = $next_stanza_line_no; + } + + if ($splice_end != -1) + { + splice (@$buf, $splice_start, $splice_end - $splice_start); + } + else + { + splice (@$buf, $splice_start); + } +} + +sub gst_replace_printcap_remove_option_slot +{ + my ($buf, $option_line_no) = @_; + splice (@$buf, $option_line_no, 1); +} + +# High-level API. +sub gst_replace_printcap_remove_printer +{ + my ($file, $printer) = @_; + my ($buf, $printtool_line_no, $stanza_line_no); + + $buf = &gst_parse_printcap_buffer_load ($file); + + ($printtool_line_no, $stanza_line_no) = &gst_parse_printcap_find_stanza ($buf, 0, $printer); + &gst_replace_printcap_remove_stanza_from_buf ($buf, $printtool_line_no, $stanza_line_no); + + $ret = &gst_replace_printcap_buffer_save ($file, $buf); + return $ret; +} + +# High-level API. +sub gst_replace_printcap +{ + my ($file, $section, $var, $type, $value) = @_; + my ($printtool_line_no, $stanza_line_no, $option_line_no); + my ($buf, $ret); + + $buf = &gst_parse_printcap_buffer_load ($file); + + ($printtool_line_no, $stanza_line_no) = &gst_parse_printcap_find_stanza ($buf, 0, $section); + if ($stanza_line_no == -1) + { + ($printtool_line_no, $stanza_line_no) = &gst_replace_printcap_add_stanza ($buf, $section); + } + + $option_line_no = &gst_parse_printcap_find_option ($buf, $stanza_line_no + 1, $var); + if ($option_line_no == -1) + { + $option_line_no = &gst_replace_printcap_add_option_slot ($buf, $stanza_line_no); + } + + if ($type ne "") + { + $$buf [$option_line_no] = "\t:" . $var . $type . $value . ":\n"; + } + elsif ($value == 1) + { + $$buf [$option_line_no] = "\t:" . $var . ":\n"; + } + else + { + &gst_replace_printcap_remove_option_slot ($buf, $option_line_no); + } + + $ret = &gst_replace_printcap_buffer_save ($file, $buf); + return $ret; +} + +# Debian /etc/network/interfaces in-line replacing methods. + +# From loaded buffer, starting at $line_no, find next debian +# interfaces format stanza. Return array ref with all stanza args. +# -1 if not found. +# NOTE: $line_no is a scalar ref. and gives the position of next stanza. +sub gst_replace_interfaces_get_next_stanza +{ + my ($buff, $line_no, $stanza_type) = @_; + my ($i, $line); + + while ($$line_no < (scalar @$buff)) + { + $_ = $$buff[$$line_no]; + $_ = &gst_parse_interfaces_line_clean ($_); + + if (/^$stanza_type[ \t]+[^ \t]/) + { + s/^$stanza_type[ \t]+//; + return [ split ("[ \t]+", $_) ]; + } + $$line_no ++; + } + + return -1; +} + +sub gst_replace_interfaces_line_is_stanza +{ + my ($line) = @_; + + return 1 if $line =~ /^(iface|auto|mapping|allow-\w+)[ \t]+[^ \t]/; + return 0; +} + +# Scan for next option. An option is something that is +# not a stanza. Return key/value tuple ref, -1 if not found. +# $$line_no will contain position. +sub gst_replace_interfaces_get_next_option +{ + my ($buff, $line_no) = @_; + my ($i, $line, $empty_lines); + + $empty_lines = 0; + + while ($$line_no < (scalar @$buff)) + { + $_ = $$buff[$$line_no]; + $_ = &gst_parse_interfaces_line_clean ($_); + + if (!/^$/) + { + return [ split ("[ \t]+", $_, 2) ] if (! &gst_replace_interfaces_line_is_stanza ($_)); + $$line_no -= $empty_lines; + return -1; + } + else + { + $empty_lines ++; + } + + $$line_no ++; + } + + $$line_no -= $empty_lines; + return -1; +} + +# Search buffer for option with key $key, starting +# at $$line_no position. Return 1/0 found result. +# $$line_no will show position. +sub gst_replace_interfaces_option_locate +{ + my ($buff, $line_no, $key) = @_; + my $option; + + while (($option = &gst_replace_interfaces_get_next_option ($buff, $line_no)) != -1) + { + return 1 if ($$option[0] eq $key); + $$line_no ++; + } + + return 0; +} + +# Locate stanza line for $iface in $buff, starting at $$line_no. +sub gst_replace_interfaces_next_stanza_locate +{ + my ($buff, $line_no) = @_; + + return &gst_replace_interfaces_get_next_stanza ($buff, \$$line_no, "(iface|auto|mapping)"); +} + +sub gst_replace_interfaces_iface_stanza_locate +{ + my ($buff, $line_no, $iface) = @_; + + return &gst_replace_interfaces_generic_stanza_locate ($buff, \$$line_no, $iface, "iface"); +} + +sub gst_replace_interfaces_auto_stanza_locate +{ + my ($buff, $line_no, $iface) = @_; + + return &gst_replace_interfaces_generic_stanza_locate ($buff, \$$line_no, $iface, "auto"); +} + +sub gst_replace_interfaces_generic_stanza_locate +{ + my ($buff, $line_no, $iface, $stanza_name) = @_; + my $stanza; + + while (($stanza = &gst_replace_interfaces_get_next_stanza ($buff, \$$line_no, $stanza_name)) != -1) + { + return 1 if ($$stanza[0] eq $iface); + $$line_no++; + } + + return 0; +} + +# Create a Debian Woody stanza, type auto, with the requested +# @ifaces as values. +sub gst_replace_interfaces_auto_stanza_create +{ + my ($buff, @ifaces) = @_; + my ($count); + + push @$buff, "\n" if ($$buff[$count] ne ""); + push @$buff, "auto " . join (" ", @ifaces) . "\n"; +} + +# Append a stanza for $iface to buffer. +sub gst_replace_interfaces_iface_stanza_create +{ + my ($buff, $iface) = @_; + my ($count); + + $count = $#$buff; + push @$buff, "\n" if ($$buff[$count] ne ""); + push @$buff, "iface $iface inet static\n"; +} + +# Delete $iface stanza and all its option lines. +sub gst_replace_interfaces_iface_stanza_delete +{ + my ($file, $iface) = @_; + my ($buff, $line_no, $line_end, $stanza); + + $buff = &gst_file_buffer_load ($file); + &gst_file_buffer_join_lines ($buff); + $line_no = 0; + + return -1 if (!&gst_replace_interfaces_iface_stanza_locate ($buff, \$line_no, $iface)); + $line_end = $line_no + 1; + &gst_replace_interfaces_next_stanza_locate ($buff, \$line_end); + + while ($line_no < $line_end) + { + delete $$buff[$line_no]; + $line_no++; + } + + $line_no = 0; + if (&gst_replace_interfaces_auto_stanza_locate ($buff, \$line_no, $iface)) + { + $line_end = $line_no + 1; + &gst_replace_interfaces_next_stanza_locate ($buff, \$line_end); + + while ($line_no < $line_end) + { + delete $$buff[$line_no]; + $line_no++; + } + } + + &gst_file_buffer_clean ($buff); + return &gst_file_buffer_save ($buff, $file); +} + +# Find $iface stanza line and replace $pos value (ie the method). +sub gst_replace_interfaces_stanza_value +{ + my ($file, $iface, $pos, $value) = @_; + my ($buff, $line_no, $stanza); + my ($pre_space, $line, $line_arr); + + $buff = &gst_file_buffer_load ($file); + &gst_file_buffer_join_lines ($buff); + $line_no = 0; + + if (!&gst_replace_interfaces_iface_stanza_locate ($buff, \$line_no, $iface)) + { + $line_no = 0; + &gst_replace_interfaces_iface_stanza_create ($buff, $iface); + &gst_replace_interfaces_iface_stanza_locate ($buff, \$line_no, $iface); + } + + $line = $$buff[$line_no]; + chomp $line; + $pre_space = $1 if $line =~ s/^([ \t]+)//; + $line =~ s/^iface[ \t]+//; + @line_arr = split ("[ \t]+", $line); + $line_arr[$pos] = $value; + $$buff[$line_no] = $pre_space . "iface " . join (' ', @line_arr) . "\n"; + + &gst_file_buffer_clean ($buff); + return &gst_file_buffer_save ($buff, $file); +} + +# Find/append $key option in $iface stanza and set $value. +sub gst_replace_interfaces_option_str +{ + my ($file, $iface, $key, $value) = @_; + my ($buff, $line_no, $stanza, $ret); + my ($pre_space, $line, $line_arr); + + &gst_report_enter (); + &gst_report ("replace_ifaces_str", $key, $iface); + + $buff = &gst_file_buffer_load ($file); + &gst_file_buffer_join_lines ($buff); + $line_no = 0; + + if (!&gst_replace_interfaces_iface_stanza_locate ($buff, \$line_no, $iface)) + { + $line_no = 0; + &gst_replace_interfaces_iface_stanza_create ($buff, $iface); + &gst_replace_interfaces_iface_stanza_locate ($buff, \$line_no, $iface); + } + + $line_no++; + + if (&gst_replace_interfaces_option_locate ($buff, \$line_no, $key)) + { + if ($value eq "") # Delete option if value is empty. + { + $$buff[$line_no] = ""; + } + else + { + chomp $$buff[$line_no]; + $$buff[$line_no] =~ s/^([ \t]*$key[ \t]).*/$1/; + } + } + elsif ($value ne "") + { + $line_no --; + chomp $$buff[$line_no]; + $$buff[$line_no] =~ s/^([ \t]*)(.*)/$1$2\n$1$key /; + } + + $$buff[$line_no] .= $value . "\n" if $value ne ""; + + &gst_file_buffer_clean ($buff); + $ret = &gst_file_buffer_save ($buff, $file); + &gst_report_leave (); + return $ret; +} + +# $key option is keyword. $value says if it should exist or not. +sub gst_replace_interfaces_option_kw +{ + my ($file, $iface, $key, $value) = @_; + + return &gst_replace_interfaces_option_str ($file, $iface, $key, $value? " ": ""); +} + +# !$value says if keyword should exist or not (ie noauto). +sub gst_replace_interfaces_option_kw_not +{ + my ($file, $iface, $key, $value) = @_; + + return &gst_replace_interfaces_option_kw ($file, $iface, $key, !$value); +} + + +# Implementing pump(8) pump.conf file format replacer. +# May be useful for dhcpd too. + +# Try to find the next option, returning an array ref +# with the found key and the rest of the options in +# two items, or -1 if not found. +sub gst_replace_pump_get_next_option +{ + my ($buff, $line_no) = @_; + + while ($$line_no < (scalar @$buff)) + { + $_ = $$buff[$$line_no]; + $_ = &gst_parse_interfaces_line_clean ($_); + if ($_ ne "") + { + return [ split ("[ \t]+", $_, 2) ]; + } + + $$line_no ++; + } + + return -1; +} + +# Iterate with get_next_option, starting at $line_no +# until the option with $key is found, or eof. +# Return 0/1 as found. +sub gst_replace_pump_option_locate +{ + my ($buff, $line_no, $key) = @_; + my ($opt); + + while (($opt = &gst_replace_pump_get_next_option ($buff, $line_no)) != -1) + { + return 1 if $$opt[0] eq $key; + return 0 if $$opt[0] eq "}"; + + $$line_no ++; + } + + return 0; +} + +# Try to find a "device" option whose interface is $iface, +# starting at $$line_no. Return 0/1 as found. +sub gst_replace_pump_get_device +{ + my ($buff, $line_no, $iface) = @_; + my ($opt); + + while (($opt = &gst_replace_pump_get_next_option ($buff, $line_no)) != -1) + { + if ($$opt[0] eq "device") + { + $$opt[1] =~ s/[ \t]*\{//; + return 1 if $$opt[1] eq $iface; + } + + $$line_no ++; + } + + return 0; +} + +# Add a device entry for $iface at the end of $buff. +sub gst_replace_pump_add_device +{ + my ($buff, $iface) = @_; + + push @$buff, "\n"; + push @$buff, "device $iface {\n"; + push @$buff, "\t\n"; + push @$buff, "}\n"; +} + +# Find a "device" section for $iface and +# replace/add/delete the $key option inside the section. +sub gst_replace_pump_iface_option_str +{ + my ($file, $iface, $key, $value) = @_; + my ($line_no, $ret); + + $buff = &gst_file_buffer_load ($file); + $line_no = 0; + + if (!&gst_replace_pump_get_device ($buff, \$line_no, $iface)) + { + $line_no = 0; + &gst_replace_pump_add_device ($buff, $iface); + &gst_replace_pump_get_device ($buff, \$line_no, $iface); + } + + $line_no ++; + + if (&gst_replace_pump_option_locate ($buff, \$line_no, $key)) + { + if ($value eq "") + { + $$buff[$line_no] = ""; + } + else + { + chomp $$buff[$line_no]; + $$buff[$line_no] =~ s/^([ \t]*$key[ \t]).*/$1/; + } + } + elsif ($value ne "") + { + $line_no --; + chomp $$buff[$line_no]; + $$buff[$line_no] =~ s/^([ \t]*)(.*)/$1$2\n$1$key /; + } + + if ($value ne "") + { + $value =~ s/^[ \t]+//; + $value =~ s/[ \t]+$//; + $$buff[$line_no] .= &gst_parse_shell_escape ($value) . "\n"; + } + + &gst_file_buffer_clean ($buff); + $ret = &gst_file_buffer_save ($buff, $file); + &gst_report_leave (); + return $ret; +} + +# Same as function above, except $key is a keyword. +sub gst_replace_pump_iface_kw +{ + my ($file, $iface, $key, $value) = @_; + + return &gst_replace_pump_iface_option_str ($file, $iface, $key, $value? " ": ""); +} + +# Same, but use the negative of $value (i.e. nodns) +sub gst_replace_pump_iface_kw_not +{ + my ($file, $iface, $key, $value) = @_; + + return &gst_replace_pump_iface_kw ($file, $iface, $key, !$value); +} + +sub gst_replace_xml_pcdata +{ + my ($file, $varpath, $data) = @_; + my ($model, $branch, $fd, $compressed); + + ($model, $compressed) = &gst_xml_model_scan ($file); + $branch = &gst_xml_model_ensure ($model, $varpath); + + &gst_xml_model_set_pcdata ($branch, $data); + + return &gst_xml_model_save ($model, $file, $compressed); +} + +sub gst_replace_xml_attribute +{ + my ($file, $varpath, $attr, $value) = @_; + my ($model, $branch, $fd, $compressed); + + ($model, $compressed) = &gst_xml_model_scan ($file); + $branch = &gst_xml_model_ensure ($model, $varpath); + + &gst_xml_model_set_attribute ($branch, $attr, $value); + + return &gst_xml_model_save ($model, $file, $compressed); +} + +sub gst_replace_xml_pcdata_with_type +{ + my ($file, $varpath, $type, $data) = @_; + my ($model, $branch, $fd, $compressed); + + ($model, $compressed) = &gst_xml_model_scan ($file); + $branch = &gst_xml_model_ensure ($model, $varpath); + + &gst_xml_model_set_pcdata ($branch, $data); + &gst_xml_model_set_attribute ($branch, "TYPE", $type); + + return &gst_xml_model_save ($model, $file, $compressed); +} + +sub gst_replace_xml_attribute_with_type +{ + my ($file, $varpath, $attr, $type, $value) = @_; + my ($model, $branch, $fd, $compressed); + + ($model, $compressed) = &gst_xml_model_scan ($file); + $branch = &gst_xml_model_ensure ($model, $varpath); + + &gst_xml_model_set_attribute ($branch, $attr, $value); + &gst_xml_model_set_attribute ($branch, "TYPE", $type); + + return &gst_xml_model_save ($model, $file, $compressed); +} + +sub gst_replace_alchemist_ensure_list_types +{ + my ($model, $varpath, $setpath) = @_; + my ($branch, @path); + + $branch = &gst_xml_model_find ($model, $varpath); + @path = split /\//, $setpath; + + # NOTE: The following could be done with a depth-iterator callback from a func + # similar to gst_xml_model_find (). + + for $elem (@path) + { + next if ($elem eq ""); + my @children = @$branch; + shift @children; # Attributes + $branch = undef; + + while (@children) + { + if ($children [0] eq $elem) + { + shift @children; + $branch = shift @children; + &gst_xml_model_set_attribute ($branch, "TYPE", "LIST"); + last; + } + + shift @children; + shift @children; + } + + last if ($branch == undef); + } +} + +sub gst_replace_alchemist +{ + my ($file, $varpath, $type, $value) = @_; + my ($fullpath, $model, $branch, $fd, $compressed); + + $fullpath = "/adm_context/datatree/" . $varpath; + ($model, $compressed) = &gst_xml_model_scan ($file); + $branch = &gst_xml_model_ensure ($model, $fullpath); + &gst_replace_alchemist_ensure_list_types ($model, "/adm_context/datatree/", $varpath); + + &gst_xml_model_set_attribute ($branch, "VALUE", $value); + &gst_xml_model_set_attribute ($branch, "TYPE", $type); + + return &gst_xml_model_save ($model, $file, $compressed); +} + +sub gst_replace_alchemist_print +{ + my ($file, $printer, $varpath, $type, $value) = @_; + my ($fullpath, $model, $branch, $fd, $compressed); + + $fullpath = "/adm_context/datatree/printconf/print_queues/" . $printer . "/" . $varpath; + ($model, $compressed) = &gst_xml_model_scan ($file); + + $branch = &gst_xml_model_ensure ($model, $fullpath); + + &gst_replace_alchemist_ensure_list_types ($model, "/adm_context/datatree/", + "printconf/print_queues/" . $printer . "/" . $varpath); + + &gst_xml_model_set_attribute ($branch, "VALUE", $value); + &gst_xml_model_set_attribute ($branch, "TYPE", $type); + + $branch = &gst_xml_model_find ($model, "/adm_context/datatree/printconf/print_queues/" . $printer); + &gst_xml_model_set_attribute ($branch, "ATOMIC", "TRUE"); + + return &gst_xml_model_save ($model, $file, $compressed); +} + +# This could be split up. +sub gst_replace_alchemist_print_option +{ + my ($file, $printer, $name, $type, $value) = @_; + my ($varpath, $model, $branch, $fd, $compressed, $options, $option); + + ($model, $compressed) = &gst_xml_model_scan ($file); + $branch = &gst_xml_model_ensure ($model, "/adm_context/datatree/printconf/print_queues/" . $printer . + "/filter_data/foomatic_defaults"); + &gst_replace_alchemist_ensure_list_types ($model, "/adm_context/datatree/", "printconf/print_queues/" . + $printer . "/filter_data/foomatic_defaults"); + &gst_xml_model_set_attribute ($branch, "ANONYMOUS", "TRUE"); + + # See if option is already defined. + + $options = &gst_xml_model_get_children ($branch); + + foreach $o (@$options) + { + my $opt_node = &gst_xml_model_find ($o, "name"); + next if (!$opt_node); + + if (&gst_xml_model_get_attribute ($opt_node, "VALUE") eq $name) + { + $option = $o; + last; + } + } + + # If not, create node for it. + + if (!$option) + { + $option = &gst_xml_model_add ($branch, "", $option_default); + &gst_xml_model_set_attribute ($option, "TYPE", "LIST"); + } + + # Set the option attributes. + + my $node = &gst_xml_model_ensure ($option, "name"); + &gst_xml_model_set_attribute ($node, "TYPE", "STRING"); + &gst_xml_model_set_attribute ($node, "VALUE", $name); + + $node = &gst_xml_model_ensure ($option, "type"); + &gst_xml_model_set_attribute ($node, "TYPE", "STRING"); + &gst_xml_model_set_attribute ($node, "VALUE", $type); + + $node = &gst_xml_model_ensure ($option, "default"); + &gst_xml_model_set_attribute ($node, "TYPE", "STRING"); + &gst_xml_model_set_attribute ($node, "VALUE", $value); + + return &gst_xml_model_save ($model, $file, $compressed); +} + +sub gst_replace_fq_hostname +{ + my ($file, $hostname, $domain) = @_; + + if ($domain eq undef) + { + return &gst_replace_line_first ($file, "$hostname"); + } + else + { + return &gst_replace_line_first ($file, "$hostname.$domain"); + } +} + +sub gst_replace_rcinet1conf +{ + my ($file, $iface, $kw, $val) = @_; + my ($line); + + $iface =~ s/eth//; + $line = "$kw\[$iface\]"; + + $val = "\"$val\"" if ($val ne undef); + + return &gst_replace_split ($file, $line, "[ \t]*=[ \t]*", $val); +} + +sub gst_replace_rcinet1conf_global +{ + my ($file, $kw, $val) = @_; + + $val = "\"$val\""; + + return &gst_replace_split ($file, $kw, "[ \t]*=[ \t]*", $val) +} + +sub gst_replace_wireless_opts +{ + my ($file, $iface, $proc, $kw, $value) = @_; + my $ifaces = &$proc (); + my $found = 0; + my $search = 1; + my $buff; + + foreach $i (@$ifaces) + { + $found = 1 if ($iface eq $i); + } + + $buff = &gst_file_buffer_load ($file); + + foreach $i (@$buff) + { + if (/^case/) + { + # we don't want to search inside the case + $search = 0; + } + elsif (/^esac/) + { + # we want to continue searching + $search = 1; + } + if ((/^[ \t]*$kw/) && ($search)) + { + $_ = "$kw=\"$value\""; + $found = 1; + } + } + + if (!$found) + { + push @$buff, "$kw=\"$value\""; + } + + &gst_file_buffer_clean ($buff); + return &gst_file_buffer_save ($buff, $file); +} + +# Functions for replacing in FreeBSD's /etc/ppp/ppp.conf +sub gst_replace_pppconf_common +{ + my ($pppconf, $section, $key, $string) = @_; + my ($buff, $line_no, $end_line_no, $i, $found); + + $buff = &gst_file_buffer_load ($pppconf); + + $line_no = &gst_parse_pppconf_find_stanza ($buff, $section); + + if ($line_no ne -1) + { + # The stanza exists + $line_no++; + + $end_line_no = &gst_parse_pppconf_find_next_stanza ($buff, $line_no); + $end_line_no = scalar @$buff + 1 if ($end_line_no == -1); + $end_line_no--; + + for ($i = $line_no; $i <= $end_line_no; $i++) + { + if ($$buff[$i] =~ /[ \t]+$key/) + { + if ($string ne undef) + { + $$buff[$i] = " $string\n"; + $found = 1; + } + else + { + delete $$buff[$i]; + } + } + } + + if ($found != 1) + { + $$buff[$end_line_no] .= " $string\n" if ($string ne undef); + } + } + else + { + if ($string ne undef) + { + push @$buff, "$section:\n"; + push @$buff, " $string\n"; + } + } + + &gst_file_buffer_clean ($buff); + return &gst_file_buffer_save ($buff, $pppconf); +} + +sub gst_replace_pppconf +{ + my ($pppconf, $section, $key, $value) = @_; + &gst_replace_pppconf_common ($pppconf, $section, $key, "set $key $value"); +} + +sub gst_replace_pppconf_bool +{ + my ($pppconf, $section, $key, $value) = @_; + &gst_replace_pppconf_common ($pppconf, $section, $key, + ($value == 1)? "enable $key" : "disable $key"); +} + +sub gst_replace_confd_net_re +{ + my ($file, $key, $re, $value) = @_; + my ($str, $contents, $i, $found, $done); + + $found = $done = 0; + $contents = &gst_file_buffer_load ($file); + + for ($i = 0; $i <= scalar (@$contents); $i++) + { + # search for key + if ($$contents[$i] =~ /^$key[ \t]*=[ \t]*\(/) + { + $found = 1; + + do { + if ($$contents[$i] =~ /\"([^\"]*)\"/) + { + $str = $1; + + if ($str =~ /$re/) + { + $str =~ s/$re/$value/; + } + else + { + $str .= $value; + } + + $$contents[$i] =~ s/\"([^\"]*)\"/\"$str\"/; + $done = 1; + } + + $i++; + } while (!$done); + } + } + + if (!$found) + { + push @$contents, "$key=(\"$value\")\n"; + } + + return &gst_file_buffer_save ($contents, $file); +} + +sub gst_replace_confd_net +{ + my ($file, $key, $value) = @_; + + return &gst_replace_confd_net_re ($file, $key, ".*", $value); +} |