#-*- 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 # Arturo Espinosa # Michael Vogt - Debian 2.[2|3] support. # David Lee Ludwig - 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. package Utils::Replace; use Utils::Util; use Utils::File; use Utils::Parse; # 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: # split_first_str -> 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 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 &run_entry ($values_hash, $key, $proc, $ncp, $value); } return $res; } } # OK, the given entry didn't have any array refs in it... return -1 if (!&Utils::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 set_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 = &Utils::Parse::replace_files (shift (@cp), $fn); unshift @cp, @files if (scalar @files) > 0; # treat empty values as undef delete $$values_hash{$key} if ($$values_hash{$key} eq ""); if ((exists $$values_hash{$key}) or ($key eq "_always_")) { $res = &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 data structure $res = &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 regexp_to_separator { $_ = $_[0]; s/\[([^^])([^\]])[^\]]*\]/$1/g; s/\+//g; s/\$//g; s/[^\*]\*//g; return $_; } sub set_value { my ($key, $val, $re) = @_; return $key . ®exp_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 split { my ($file, $key, $re, @value) = @_; my ($fd, @line, @res); my ($buff, $i); my ($pre_space, $post_comment); my ($line_key, $val, $ret); &Utils::Report::enter (); &Utils::Report::do_report ("replace_split", $key, $file); $buff = &Utils::File::load_buffer ($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 ""); } &Utils::File::clean_buffer ($buff); $ret = &Utils::File::save_buffer ($buff, $file); &Utils::Report::leave (); return $ret; } # Replace all key/values in file with those in @$value, # deleting exceeding ones and appending those required. sub join_all { my ($file, $key, $re, $value) = @_; return &split ($file, $key, $re, @$value); } # Find first $key value and replace with $value. Append if not found. sub join_first_str { my ($file, $key, $re, $value) = @_; return &split ($file, $key, $re, $value); } # Treat value as a bool value, using val_off and val_on as corresponding # boolean representations. sub 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 &split ($file, $key, $re, $value); } # Find first key in file, and set array join as value. sub join_first_array { my ($file, $key, $re1, $re2, $value) = @_; return &split ($file, $key, $re1, join (®exp_to_separator ($re2), @$value)); } # Escape $value in /bin/sh way, find/append key and set escaped value. sub set_sh { my ($file, $key, $value, $unescaped) = @_; my $ret; $value = &Utils::Parse::escape ($value) unless $unescaped; &Utils::Report::enter (); &Utils::Report::do_report ("replace_sh", $key, $file); # This will expunge the whole var if the value is empty. if ($value eq "") { $ret = &split ($file, $key, "[ \t]*=[ \t]*"); } else { $ret = &split ($file, $key, "[ \t]*=[ \t]*", $value); } &Utils::Report::leave (); return $ret; } # Escape $value in /bin/sh way, find/append key and set escaped value, make sure line har sub set_sh_export { my ($file, $key, $value) = @_; my $ret; $value = &Utils::Parse::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 split() # here. if ($value eq "") { $ret = &split ($file, "export " . $key, "[ \t]*=[ \t]*"); } else { $ret = &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 &set_sh_bool (file, key, value) if defaults are desired. sub set_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 &set_sh ($file, $key, $value); } # Treat value as a yes/no bool, replace in export... shell style. sub set_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 &set_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 set_hostname { my ($file, $key, $value) = @_; my ($domain); $domain = &Utils::Parse::get_sh_domain ($file, $key); return &set_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 set_domain { my ($file, $key, $value) = @_; my ($hostname); $hostname = &Utils::Parse::get_sh_hostname ($file, $key); return &set_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 set_sh_join { my ($file, $key, $re, $value) = @_; return &set_sh ($file, $key, join (®exp_to_separator ($re), @$value)); } # replace a regexp with $value sub set_sh_re { my ($file, $key, $re, $value) = @_; my ($val); $val = &Utils::Parse::get_sh ($file, $key); if ($val =~ /$re/) { $val =~ s/$re/$value/; } else { $val .= $value; } $val = '"' . $val . '"' if ($val !~ /^\".*\"$/); return &split ($file, $key, "[ \t]*=[ \t]*", $val) } # Quick trick to set a keyword $key in $file. (think /etc/lilo.conf keywords). sub set_kw { my ($file, $key, $value) = @_; my $ret; &Utils::Report::enter (); &Utils::Report::do_report ("replace_kw", $key, $file); $ret = &split ($file, $key, "\$", ($value)? "\n" : ""); &Utils::Report::leave (); return $ret; } # The kind of $file whose $value is its first line contents. # (/etc/hostname) sub set_first_line { my ($file, $value) = @_; my $fd; &Utils::Report::enter (); &Utils::Report::do_report ("replace_line_first", $file); $fd = &Utils::File::open_write_from_names ($file); &Utils::Report::leave (); return -1 if !$fd; print $fd "$value\n"; &Utils::File::close_file ($fd); return 0; } # For every key in %$value, replace/append the corresponding key/value pair. # The separator for $re1 sub join_hash { my ($file, $re1, $re2, $value) = @_; my ($i, $res, $tmp, $val); my ($oldhash, %merge); $oldhash = &Utils::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 (®exp_to_separator ($re2), @{$$value{$i}}); $tmp = &split ($file, $i, $re1, $val); } else { # This deletes the entry. $tmp = &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 set_chat { my ($file, $re, $value) = @_; my ($buff, $i, $bak, $found, $substr, $ret); &Utils::Report::enter (); &Utils::Report::do_report ("replace_chat", $file); $buff = &Utils::File::load_buffer ($file); SCAN: foreach $i (@$buff) { $bak = ""; $found = ""; my ($quoted); chomp $i; while ($i ne "") { $i =~ s/^\s*//; # 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; $substr =~ s/\*/\\\*/g; $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 = &Utils::File::save_buffer ($buff, $file); &Utils::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 set_ini { my ($file, $section, $var, $value) = @_; my ($buff, $i, $found_flag, $ret); my ($pre_space, $post_comment, $sec_save); my ($escaped_section); &Utils::Report::enter (); &Utils::Report::do_report ("replace_ini", $var, $section, $file); $buff = &Utils::File::load_buffer ($file); &Utils::File::join_buffer_lines ($buff); $found_flag = 0; $escaped_section = Utils::Parse::escape ($section); 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 =~ /\[$escaped_section\]/i) { $i =~ s/(\[$escaped_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 ""); &Utils::File::clean_buffer ($buff); $ret = &Utils::File::save_buffer ($buff, $file); &Utils::Report::leave (); return $ret; } # Well, removes a $section from an ini type $file. sub remove_ini_section { my ($file, $section) = @_; my ($buff, $i, $found_flag, $ret); my ($pre_space, $post_comment, $sec_save); my ($escaped_section); &Utils::Report::enter (); &Utils::Report::do_report ("replace_del_ini_sect", $section, $file); $buff = &Utils::File::load_buffer ($file); $escaped_section = &Utils::Parse::escape ($section); &Utils::File::join_buffer_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 =~ /\[$escaped_section\]/i) { $i =~ s/(\[$escaped_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"; } } &Utils::File::clean_buffer ($buff); $ret = &Utils::File::save_buffer ($buff, $file); &Utils::Report::leave (); return $ret; } # Removes a $var in $section of a ini type $file. sub remove_ini_var { my ($file, $section, $var) = @_; &set_ini ($file, $section, $var, ""); } # Replace using boolean $value with a yes/no representation, # ini style. sub set_ini_bool { my ($file, $section, $var, $value) = @_; $value = ($value == 0)? "no": "yes"; return &set_ini ($file, $section, $var, $value); } # 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 interfaces_get_next_stanza { my ($buff, $line_no, $stanza_type) = @_; my ($i, $line); while ($$line_no < (scalar @$buff)) { $_ = $$buff[$$line_no]; $_ = &Utils::Parse::interfaces_line_clean ($_); if (/^$stanza_type[ \t]+[^ \t]/) { s/^$stanza_type[ \t]+//; return [ split ("[ \t]+", $_) ]; } $$line_no ++; } return -1; } sub interfaces_line_is_stanza { my ($line) = @_; return 1 if $line =~ /^(iface|auto|mapping)[ \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 interfaces_get_next_option { my ($buff, $line_no) = @_; my ($i, $line, $empty_lines); $empty_lines = 0; while ($$line_no < (scalar @$buff)) { $_ = $$buff[$$line_no]; $_ = &Utils::Parse::interfaces_line_clean ($_); if (!/^$/) { return [ split ("[ \t]+", $_, 2) ] if (! &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 interfaces_option_locate { my ($buff, $line_no, $key) = @_; my $option; while (($option = &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 interfaces_next_stanza_locate { my ($buff, $line_no) = @_; return &interfaces_get_next_stanza ($buff, \$$line_no, "(iface|auto|mapping)"); } sub interfaces_iface_stanza_locate { my ($buff, $line_no, $iface) = @_; return &interfaces_generic_stanza_locate ($buff, \$$line_no, $iface, "iface"); } sub interfaces_auto_stanza_locate { my ($buff, $line_no, $iface) = @_; return &interfaces_generic_stanza_locate ($buff, \$$line_no, $iface, "auto"); } sub interfaces_generic_stanza_locate { my ($buff, $line_no, $iface, $stanza_name) = @_; my $stanza; while (($stanza = &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 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 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 interfaces_iface_stanza_delete { my ($file, $iface) = @_; my ($buff, $line_no, $line_end, $stanza); $buff = &Utils::File::load_buffer ($file); &Utils::File::join_buffer_lines ($buff); $line_no = 0; return -1 if (!&interfaces_iface_stanza_locate ($buff, \$line_no, $iface)); $line_end = $line_no + 1; &interfaces_next_stanza_locate ($buff, \$line_end); while ($line_no < $line_end) { delete $$buff[$line_no]; $line_no++; } $line_no = 0; if (&interfaces_auto_stanza_locate ($buff, \$line_no, $iface)) { $line_end = $line_no + 1; &interfaces_next_stanza_locate ($buff, \$line_end); while ($line_no < $line_end) { delete $$buff[$line_no]; $line_no++; } } &Utils::File::clean_buffer ($buff); return &Utils::File::save_buffer ($buff, $file); } # Find $iface stanza line and replace $pos value (ie the method). sub set_interfaces_stanza_value { my ($file, $iface, $pos, $value) = @_; my ($buff, $line_no, $stanza); my ($pre_space, $line, $line_arr); $buff = &Utils::File::load_buffer ($file); &Utils::File::join_buffer_lines ($buff); $line_no = 0; if (!&interfaces_iface_stanza_locate ($buff, \$line_no, $iface)) { $line_no = 0; &interfaces_iface_stanza_create ($buff, $iface); &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"; &Utils::File::clean_buffer ($buff); return &Utils::File::save_buffer ($buff, $file); } # Find/append $key option in $iface stanza and set $value. sub set_interfaces_option_str { my ($file, $iface, $key, $value) = @_; my ($buff, $line_no, $stanza, $ret); my ($pre_space, $line, $line_arr); &Utils::Report::enter (); &Utils::Report::do_report ("replace_ifaces_str", $key, $iface); $buff = &Utils::File::load_buffer ($file); &Utils::File::join_buffer_lines ($buff); $line_no = 0; if (!&interfaces_iface_stanza_locate ($buff, \$line_no, $iface)) { $line_no = 0; &interfaces_iface_stanza_create ($buff, $iface); &interfaces_iface_stanza_locate ($buff, \$line_no, $iface); } $line_no++; if (&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 ""; &Utils::File::clean_buffer ($buff); $ret = &Utils::File::save_buffer ($buff, $file); &Utils::Report::leave (); return $ret; } # $key option is keyword. $value says if it should exist or not. sub set_interfaces_option_kw { my ($file, $iface, $key, $value) = @_; return &set_interfaces_option_str ($file, $iface, $key, $value? " ": ""); } # !$value says if keyword should exist or not (ie noauto). sub set_interfaces_option_kw_not { my ($file, $iface, $key, $value) = @_; return &set_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 pump_get_next_option { my ($buff, $line_no) = @_; while ($$line_no < (scalar @$buff)) { $_ = $$buff[$$line_no]; $_ = &Utils::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 pump_option_locate { my ($buff, $line_no, $key) = @_; my ($opt); while (($opt = &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 pump_get_device { my ($buff, $line_no, $iface) = @_; my ($opt); while (($opt = &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 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 set_pump_iface_option_str { my ($file, $iface, $key, $value) = @_; my ($line_no, $ret); $buff = &Utils::File::load_buffer ($file); $line_no = 0; if (!&pump_get_device ($buff, \$line_no, $iface)) { $line_no = 0; &pump_add_device ($buff, $iface); &pump_get_device ($buff, \$line_no, $iface); } $line_no ++; if (&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] .= &Utils::Parse::escape ($value) . "\n"; } &Utils::File::clean_buffer ($buff); $ret = &Utils::File::save_buffer ($buff, $file); &Utils::Report::leave (); return $ret; } # Same as function above, except $key is a keyword. sub set_pump_iface_kw { my ($file, $iface, $key, $value) = @_; return &set_pump_iface_option_str ($file, $iface, $key, $value? " ": ""); } # Same, but use the negative of $value (i.e. nodns) sub set_pump_iface_kw_not { my ($file, $iface, $key, $value) = @_; return &set_pump_iface_kw ($file, $iface, $key, !$value); } sub set_xml_pcdata { my ($file, $varpath, $data) = @_; my ($model, $branch, $fd, $compressed); ($model, $compressed) = &Utils::XML::model_scan ($file); $branch = &Utils::XML::model_ensure ($model, $varpath); &Utils::XML::model_set_pcdata ($branch, $data); return &Utils::XML::model_save ($model, $file, $compressed); } sub set_xml_attribute { my ($file, $varpath, $attr, $value) = @_; my ($model, $branch, $fd, $compressed); ($model, $compressed) = &Utils::XML::model_scan ($file); $branch = &Utils::XML::model_ensure ($model, $varpath); &Utils::XML::model_set_attribute ($branch, $attr, $value); return &Utils::XML::model_save ($model, $file, $compressed); } sub set_xml_pcdata_with_type { my ($file, $varpath, $type, $data) = @_; my ($model, $branch, $fd, $compressed); ($model, $compressed) = &Utils::XML::model_scan ($file); $branch = &Utils::XML::model_ensure ($model, $varpath); &Utils::XML::model_set_pcdata ($branch, $data); &Utils::XML::model_set_attribute ($branch, "TYPE", $type); return &Utils::XML::model_save ($model, $file, $compressed); } sub set_xml_attribute_with_type { my ($file, $varpath, $attr, $type, $value) = @_; my ($model, $branch, $fd, $compressed); ($model, $compressed) = &Utils::XML::model_scan ($file); $branch = &Utils::XML::model_ensure ($model, $varpath); &Utils::XML::model_set_attribute ($branch, $attr, $value); &Utils::XML::model_set_attribute ($branch, "TYPE", $type); return &Utils::XML::model_save ($model, $file, $compressed); } sub set_fq_hostname { my ($file, $hostname, $domain) = @_; if ($domain eq undef) { return &set_first_line ($file, "$hostname"); } else { return &set_first_line ($file, "$hostname.$domain"); } } sub set_rcinet1conf { my ($file, $iface, $kw, $val) = @_; my ($line); $iface =~ s/eth//; $line = "$kw\[$iface\]"; $val = "\"$val\""; return &split ($file, $line, "[ \t]*=[ \t]*", $val); } sub set_rcinet1conf_global { my ($file, $kw, $val) = @_; $val = "\"$val\""; return &split ($file, $kw, "[ \t]*=[ \t]*", $val) } # Functions for replacing in FreeBSD's /etc/ppp/ppp.conf sub set_pppconf_common { my ($pppconf, $section, $key, $string) = @_; my ($buff, $line_no, $end_line_no, $i, $found); $buff = &Utils::File::load_buffer ($pppconf); $line_no = &Utils::Parse::pppconf_find_stanza ($buff, $section); if ($line_no ne -1) { # The stanza exists $line_no++; $end_line_no = &Utils::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"; } } &Utils::File::clean_buffer ($buff); return &Utils::File::save_buffer ($buff, $pppconf); } sub set_pppconf { my ($pppconf, $section, $key, $value) = @_; &set_pppconf_common ($pppconf, $section, $key, "set $key $value"); } sub set_pppconf_bool { my ($pppconf, $section, $key, $value) = @_; &set_pppconf_common ($pppconf, $section, $key, ($value == 1)? "enable $key" : "disable $key"); } sub set_ppp_options_re { my ($file, $re, $value) = @_; my ($buff, $line, $replaced, $ret); my ($pre_space, $post_comment); &Utils::Report::enter (); &Utils::Report::do_report ("network_set_ppp_option", &Utils::Replace::regexp_to_separator ($re), $file); $buff = &Utils::File::load_buffer ($file); foreach $line (@$buff) { $pre_space = $post_comment = ""; chomp $line; $pre_space = $1 if $line =~ s/^([ \t]+)//; $post_comment = $1 if $line =~ s/([ \t]*\#.*)//; if ($line =~ /$re/) { $line = "$value\n"; $replaced = 1; last; } $line = $pre_space . $line . $post_comment . "\n"; } push @$buff, "$value\n" if !$replaced; &Utils::File::clean_buffer ($buff); $ret = &Utils::File::save_buffer ($buff, $file); &Utils::Report::leave (); return $ret; } sub set_ppp_options_connect { my ($file, $value) = @_; my $ret; &Utils::Report::enter (); &Utils::Report::do_report ("network_set_ppp_connect", $file); $ret = &set_ppp_options_re ($file, "^connect", "connect \"/usr/sbin/chat -v -f /etc/chatscripts/$value\""); &Utils::Report::leave (); return $ret; } sub set_confd_net_re { my ($file, $key, $re, $value) = @_; my ($str, $contents, $i, $found, $done); $found = $done = 0; $contents = &Utils::File::load_buffer ($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 &Utils::File::save_buffer ($contents, $file); } sub set_confd_net { my ($file, $key, $value) = @_; return &set_confd_net_re ($file, $key, ".*", $value); } 1;