#!/usr/bin/env perl #-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- # parse.pl: Common parsing stuff for the ximian-setup-tools backends. # # Copyright (C) 2000-2001 Ximian, Inc. # # Authors: Hans Petter Jansson # Arturo Espinosa # # 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/debug.pl$DOTIN"; # The concept of keyword (kw) here is a key, normaly in its own line, whose # boolean representation is its own existence. # Every final parsing function to be used by a table must handle one key # at a time, but maybe parse several values from there and return a # ref to array or hash. # # Always return a scalar. If you need to return an array or a hash, # return a ref to it. # First some helper functions for the whole process. # Expand substrings of the form #$substr# to the $value in # the string or recursively in the array $strarr. sub gst_parse_expand { my ($strarr, $substr, $value) = @_; if (ref $strarr eq "ARRAY") { my ($i); $strarr = [ @$strarr ]; foreach $i (@$strarr) { $i = &gst_parse_expand ($i, $substr, $value); } return $strarr; } $strarr =~ s/\#$substr\#/$value/; return $strarr; } sub gst_parse_replace_hash_values { my ($cp, $hash) = @_; my ($j, $replace_key, $value); foreach $j (@$cp) { while ($j =~ /%([^%]*)%/) { $replace_key = $1; if (exists $$hash{$replace_key}) { $value = $$hash{$replace_key}; if (ref $value) { $j = $value; } else { $j =~ s/%$replace_key%/$value/g; } } else { &gst_debug_print_line ("Warning: gst_parse_replace_hash_values: key $replace_key doesn't exist."); return 0; } } } return 1; } sub gst_parse_replace_files { my ($values, $fn_hash) = @_; my @ret; return () if $values eq undef; $values = [$values] if !ref $values; foreach $i (@$values) { if (exists $$fn_hash{$i}) { push @ret, $$fn_hash{$i}; } else { push @ret, $i; } } return @ret; } # Additional abstraction: parse table entries can have # arrays inside. The parsing proc will be ran with every # combination that the arrays provide. Ex: # ["user", \&gst_parse_foo, [0, 1], [2, 3] ] will parse # using the combinatory of [0, 1]x[2, 3] until a result # ne undef is given. Check RedHat 7.2's network parse table # for further enlightenment. sub gst_parse_run_entry { my ($hash, $key, $proc, $cp) = @_; 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 = &gst_parse_run_entry ($hash, $key, $proc, $ncp); return $res if $res ne undef; } return undef; } } # OK, the given entry didn't have any array refs in it... return undef if (!&gst_parse_replace_hash_values ($cp, $hash)); &gst_report_enter (); &gst_report ("parse_table", "$key"); &gst_report_leave (); $$hash{$key} = &$proc (@$cp); return $$hash{$key}; } # OK, this is the good stuff: # gst_parse_from_table takes a file mapping and a parse table. # # 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 value the parse function returns is set into a hash, # using as key the first item of the parse table entry. This is done # only if the $hash{$key} is empty, which allows us to try with # several parse methods to try to get a value, where our parse functions # can return undef if they failed to get the requested value. # # A ref to the hash with all the fetched values is returned. sub gst_parse_from_table { my ($fn, $table) = @_; my %hash; my ($key, $proc, @param); my ($i, @cp, @files); foreach $i (@$table) { @cp = @$i; $key = shift (@cp); if ($hash{$key} eq undef) { $proc = shift (@cp); @files = &gst_parse_replace_files (shift (@cp), $fn); # Don't unshift the resulting files if none were given. unshift @cp, @files if (scalar @files) > 0; &gst_parse_run_entry (\%hash, $key, $proc, \@cp); } } foreach $i (keys (%hash)) { delete $hash{$i} if ($hash{$i} eq undef); } return \%hash; } # Just return the passed values. If there's just # one value, the value. If more, a reference to an # array with the values. sub gst_parse_trivial { my (@res) = @_; &gst_report_enter (); &gst_report ("parse_trivial", "@res"); &gst_report_leave (); return $res[0] if (scalar @res) <= 1; return \@res; } # Try to read a line from $fd and remove any leading or # trailing white spaces. Return ref to read $line or # -1 if eof. sub gst_parse_chomp_line_std { my ($fd) = @_; my $line; $line = <$fd>; return -1 if !$line; chomp $line; $line =~ s/^[ \t]+//; $line =~ s/[ \t]+$//; return \$line; } # Assuming $line is a line read from a shell file, # remove comments. sub gst_parse_process_sh_line { my ($line) = @_; my ($pline); # This will put escaped hashes out of danger. # But only inside valid quotes! while ($line =~ /([^\"\']*[\"\'][^\#\"\']*)(\#?)([^\"\']*[\"\'])/g) { $pline .= $1; $pline .= "__hash__" if ($2 ne undef); $pline .= $3; } # The line may not match the regexp above, $pline = $line if ($pline eq undef); $pline =~ s/\\\#/\\__hash__/g; # Nuke everything after a hash and bye bye trailing spaces. $pline =~ s/[ \t]*\#.*//; # Let escaped hashes come back home. $pline =~ s/__hash__/\#/g; return $pline; } # Same as gst_parse_chomp_line_std, but apply # the sh line processing before returning. # -1 if eof, ref to read $line if success. sub gst_parse_chomp_line_hash_comment { my ($fd) = @_; my $line; $line = &gst_parse_chomp_line_std ($fd); return -1 if $line == -1; $line = &gst_parse_process_sh_line ($$line); return \$line; } # Get an sh line, and remove the export keyword, if any. sub gst_parse_chomp_line_sh_export { my ($fd) = @_; my $line; $line = &gst_parse_chomp_line_hash_comment ($fd); return -1 if $line == -1; $line = $$line; $line =~ s/^export //; return \$line; } # Parse a $file, wich is assumed to have a column-based format, with $re matching field separators # and one record per line. Search for $key, and return either a scalar with the first ocurrence, # or an array with all the found ocurrences. sub gst_parse_split_ref { my ($file, $key, $re, $all, $line_read_proc) = @_; my ($fd, @line, @res); &gst_report_enter (); &gst_report ("parse_split", $key, $file); $proc = $line_read_proc? $line_read_proc : \&gst_parse_chomp_line_std; $fd = &gst_file_open_read_from_names ($file); $all = 0 if !$fd; while (($line = &$proc ($fd)) != -1) { $line = $$line; next if $line eq ""; @line = split ($re, $line, 2); if (shift (@line) =~ "^$key\$") { if ($all) { push @res, $line[0]; } else { &gst_report_leave (); &gst_file_close ($fd); return \$line[0]; } } } &gst_report_leave (); &gst_file_close ($fd); return \@res if ($all); return -1; } sub gst_parse_split { my $res; # Don't pass @_ like this anywhere. This is bad practice. $res = &gst_parse_split_ref (@_); return $$res if ref $res eq "SCALAR"; return @$res if ref $res eq "ARRAY"; return undef; } # This gives meaning to the $all flag of gst_parse_split, and returns a reference to the array, which # is what we want. (ie search a.com\nsearch b.com\nsearch c.com) sub gst_parse_split_all { my ($file, $key, $re, $line_read_proc) = @_; my @a; @a = &gst_parse_split ($file, $key, $re, 1, $line_read_proc); return \@a; } # Same, but use the hash_comment routine for line analysis. sub gst_parse_split_all_hash_comment { my ($file, $key, $re) = @_; return &gst_parse_split_all ($file, $key, $re, \&gst_parse_chomp_line_hash_comment); } # Make the elements of the resulting array unique. sub gst_parse_split_all_unique_hash_comment { my ($file, $key, $re) = @_; my ($arr, @res); my (%hash, $i); $arr = &gst_parse_split_all ($file, $key, $re, \&gst_parse_chomp_line_hash_comment); foreach $i (@$arr) { next if exists $hash{$i}; $hash{$i} = 1; push @res, $i; } return \@res; } sub gst_parse_split_all_array_with_pos { my ($file, $key, $pos, $re, $sep, $line_read_proc) = @_; my ($arr, @s, @ret, $i); $arr = &gst_parse_split_all ($file, $key, $re, $line_read_proc); foreach $i (@$arr) { @s = split ($sep, $i); push @ret, @s[0]; } return \@ret; } # Same, but for $all = 0. (ie nameserver 10.0.0.1) sub gst_parse_split_first_str { my ($file, $key, $re, $line_read_proc) = @_; return &gst_parse_split ($file, $key, $re, 0, $line_read_proc); } # Interpret the result as a boolean. (ie multi on) sub gst_parse_split_first_bool { my ($file, $key, $re, $line_read_proc) = @_; my $ret; $ret = &gst_parse_split_first_str ($file, $key, $re, $line_read_proc); return undef if ($ret eq undef); return (&gst_util_read_boolean ($ret)? 1: 0); } # After getting the first field, split the result with $sep matching separators. (ie order hosts,bind) sub gst_parse_split_first_array { my ($file, $key, $re, $sep, $line_read_proc) = @_; my @ret; @ret = split ($sep, &gst_parse_split ($file, $key, $re, 0, $line_read_proc)); return \@ret; } sub gst_parse_split_first_array_pos { my ($file, $key, $pos, $re, $sep, $line_read_proc) = @_; my (@ret); @ret = split ($sep, &gst_parse_split ($file, $key, $re, 0, $line_read_proc)); return $ret[$pos]; } # Do an gst_parse_split_first_array and then make # the array elements unique. This is to fix broken # searchdomain entries in /etc/resolv.conf, for example. sub gst_parse_split_first_array_unique { my ($file, $key, $re, $sep, $line_read_proc) = @_; my (@arr, @res); my (%hash, $i); @arr = split ($sep, &gst_parse_split ($file, $key, $re, 0, $line_read_proc)); foreach $i (@arr) { next if exists $hash{$i}; $hash{$i} = 1; push @res, $i; } return \@res; } # For all keys in $file, sepparated from its values # by $key_re, sepparate its values using $value_re # and assign to a newly created hash. Use ONLY when # you don't know what keys you are going to parse # (i.e. /etc/hosts). Any other application will not # be very portable and should be avoided. sub gst_parse_split_hash { my ($file, $key_re, $value_re) = @_; my ($fd, @line, %res, $key); &gst_report_enter (); &gst_report ("parse_split_hash", $file); $fd = &gst_file_open_read_from_names ($file); while (<$fd>) { chomp; s/^[ \t]+//; s/[ \t]+$//; s/\#.*$//; next if (/^$/); @line = split ($key_re, $_, 2); $key = shift (@line); push @{$res{$key}}, split ($value_re, $line[0]); } &gst_file_close ($fd); &gst_report_leave (); return undef if (scalar keys (%res) == 0); return \%res; } # Same as above, but join lines that end with '\'. sub gst_parse_split_hash_with_continuation { my ($file, $key_re, $value_re) = @_; my ($fd, $l, @line, %res, $key); &gst_report_enter (); &gst_report ("parse_split_hash_cont", $file); $fd = &gst_file_open_read_from_names ($file); while (($l = &gst_parse_ini_line_read ($fd)) != -1) { $_ = $$l; chomp; s/^[ \t]+//; s/[ \t]+$//; s/\#.*$//; next if (/^$/); @line = split ($key_re, $_, 2); $key = shift (@line); $res{$key} = [ split ($value_re, $line[0]) ]; } &gst_file_close ($fd); &gst_report_leave (); return undef if (scalar keys (%res) == 0); return \%res; } # Remove escape sequences in a shell value. sub gst_parse_shell_unescape { my $ret = $_[0]; # Quote shell special chars. $ret =~ s/\\\"/\\_/g; $ret =~ s/\"//g; $ret =~ s/\\_/\"/g; $ret =~ s/\\\'/\\_/g; $ret =~ s/\'//g; $ret =~ s/\\_/\'/g; $ret =~ s/\\(.)/$1/g; return $ret; } # unescape (escape (x)) == x sub gst_parse_shell_escape { my ($value) = @_; $value =~ s/([\"\`\$\\])/\\$1/g; $value = "\"$value\"" if ($value =~ /[ \t\'&|*?\[\]\{\}\{\}<>]/); return $value; } # For files which are a list of /bin/sh shell variable declarations. (ie GATEWAY=10.10.10.1) sub gst_parse_sh { my ($file, $key) = @_; my $ret; &gst_report_enter (); &gst_report ("parse_sh", $key, $file); $ret = &gst_parse_split_first_str ($file, $key, "[ \t]*=[ \t]*", \&gst_parse_chomp_line_hash_comment); &gst_report_leave (); return &gst_parse_shell_unescape ($ret); } # Same, but interpret the returning value as a bool. (ie NETWORKING=yes) sub gst_parse_sh_bool { my ($file, $key) = @_; my $ret; $ret = &gst_parse_sh ($file, $key); return undef if ($ret eq undef); return (&gst_util_read_boolean ($ret)? 1: 0); } # Get an sh value and then split with $re, returning ref to resulting array. sub gst_parse_sh_split { my ($file, $key, $re) = @_; my (@ret, $val); $val = &gst_parse_sh ($file, $key); @ret = split ($re, $val); return \@ret; } # Get a fully qualified hostname from a $key shell var in $file # and extract the hostname from there. e.g.: suse70's /etc/rc.config's FQHOSTNAME. sub gst_parse_sh_get_hostname { my ($file, $key) = @_; my ($val); $val = &gst_parse_sh_split ($file, $key, "\\."); return $$val[0]; } # Get a fully qualified hostname from a $key shell var in $file # and extract the domain from there. e.g.: suse70's /etc/rc.config's FQHOSTNAME. sub gst_parse_sh_get_domain { my ($file, $key) = @_; my ($val); $val = &gst_parse_sh_split ($file, $key, "\\."); return join ".", @$val[1..$#$val]; } # For files which are a list of /bin/sh shell variable exports. (eg export GATEWAY=10.10.10.1) sub gst_parse_sh_export { my ($file, $key) = @_; my $ret; &gst_report_enter (); &gst_report ("parse_sh", $key, $file); $ret = &gst_parse_split_first_str ($file, $key, "[ \t]*=[ \t]*", \&gst_parse_chomp_line_sh_export); &gst_report_leave (); return &gst_parse_shell_unescape ($ret); } # Same, but interpret the returing value as a bool. (ie export NETWORKING=yes) sub gst_parse_sh_export_bool { my ($file, $key) = @_; my $ret; $ret = &gst_parse_sh_export ($file, $key); return undef if ($ret eq undef); return (&gst_util_read_boolean ($ret)? 1: 0); } # Same, but accepting a regexp and returning the value between the paren operator sub gst_parse_sh_re { my ($file, $key, $re) = @_; my $ret; $ret = &gst_parse_sh ($file, $key); $ret =~ /$re/i; return $1; } # Search for $keyword in $file, delimited by $re (default " ") or EOL. # If keyword exists, return 1, else 0. sub gst_parse_kw { my ($file, $keyword, $re, $line_read_proc) = @_; my $res; &gst_report_enter (); &gst_report ("parse_kw", $keyword, $file); if (! -f "$gst_prefix/$file") { &gst_report_enter (); &gst_report ("file_open_read_failed", $file); &gst_report_leave (); &gst_report_leave (); return undef; } $re = " " if $re eq undef; $res = &gst_parse_split_ref ($file, $keyword, $re, 0, $line_read_proc); &gst_report_leave (); return 0 if $res == -1; return 1; } # A file containing the desired value in its first line. (ie /etc/hostname) sub gst_parse_line_first { my ($file) = @_; my ($fd, $res); &gst_report_enter (); &gst_report ("parse_line_first", $file); $fd = &gst_file_open_read_from_names ($file); &gst_report_leave (); return undef if !$fd; chomp ($res = <$fd>); &gst_file_close ($fd); return $res; } # parse a chat file, searching for an entry that matches $re. # $re must have one paren operator (ie "^atd[^0-9]*([0-9, -]+)"). sub gst_parse_chat { my ($file, $re) = @_; my ($fd, $found); &gst_report_enter (); &gst_report ("parse_chat", $file); $fd = &gst_file_open_read_from_names ("$file"); &gst_report_leave (); return undef if !$fd; while (<$fd>) { # We'll be emptying $_ as we "scan". chomp; while ($_ ne "") { # If it uses quotes. FIXME: Assuming they surround the whole string. if (/^\'/) { s/\'([^\']*)\' ?//; $found = $1; } else { s/([^ \t]*) ?//; $found = $1; } # If it looks like what we're looking for, return what matched the parens. if ($found =~ /$re/i) { &gst_file_close ($fd); return $1; } } } &gst_file_close ($fd); # Oops: not found. return undef; } # Clean an ini line of comments and leading or # trailing spaces. sub gst_parse_ini_line_clean { $_ = $_[0]; chomp; s/\#.*//; s/;.*//; s/^[ \t]+//; s/[ \t]+$//; return $_; } # Read an ini line, which may have to be joined # with the next one if it ends with '\'. sub gst_parse_ini_line_read { my $fd = $_[0]; my $l; $l = <$fd>; return -1 if ($l eq undef); $l = &gst_parse_ini_line_clean ($l); while ($l =~ /\\$/) { $l =~ s/\\$//; $l .= &gst_parse_ini_line_clean (scalar <$fd>); } return \$l; } # Return an array of all found sections in $file. sub gst_parse_ini_sections { my ($file) = @_; my (@sections, $line); $fd = &gst_file_open_read_from_names ($file); while (($line = &gst_parse_ini_line_read ($fd)) != -1) { $_ = $$line; next if (/^$/); push @sections, $1 if (/\[([^\]]+)\]/i); } &gst_file_close ($fd); return @sections; } # Get the value of a $var in a $section from $file. sub gst_parse_ini { my ($file, $section, $var) = @_; my ($fd, $res, $line); my $found_section_flag = 0; &gst_report_enter (); &gst_report ("parse_ini", $var, $file, $section); $fd = &gst_file_open_read_from_names ($file); &gst_report_leave (); $res = undef; while (($line = &gst_parse_ini_line_read ($fd)) != -1) { $_ = $$line; next if (/^$/); if (/\[$section\]/i) { $found_section_flag = 1; next; } if ($found_section_flag) { if (/^$var[ \t]*=/i) { s/^$var[ \t]*=[ \t]*//i; $res = $_; last; } elsif (/\[\S+\]/i) { last; } } } &gst_file_close ($fd); return $res; } # Same, but treat value as bool and return 1/0. sub gst_parse_ini_bool { my ($file, $section, $var) = @_; my $ret; $ret = &gst_parse_ini ($file, $section, $var); return undef if ($ret eq undef); return (&gst_util_read_boolean ($ret)? 1: 0); } sub gst_parse_cap_line_clean { $_ = $_[0]; chomp; s/^[ \t]*\#.*//; s/;.*//; s/^[ \t]+//; s/[ \t]+$//; return $_; } sub gst_parse_cap_line_read { my $fd = $_[0]; my $l; $l = <$fd>; return -1 if ($l eq undef); $l = &gst_parse_cap_line_clean ($l); while ($l =~ /\\$/) { $l =~ s/\\$//; $l .= &gst_parse_cap_line_clean (scalar <$fd>); } return \$l; } sub gst_parse_cap_sections { my ($file) = @_; my (@sections, $line); $fd = &gst_file_open_read_from_names ($file); while (($line = &gst_parse_cap_line_read ($fd)) != -1) { $_ = $$line; next if (/^$/); push @sections, $1 if (/^([^:|]+)/i); } &gst_file_close ($fd); return @sections; } sub gst_parse_cap { my ($file, $section, $var) = @_; my ($fd, $res, $line); my $found_section_flag = 0; $fd = &gst_file_open_read_from_names ($file); $res = undef; while (($line = &gst_parse_ini_line_read ($fd)) != -1) { $_ = $$line; next if (/^$/); if (/^$section[:|]/i) { $found_section_flag = 1; } if ($found_section_flag && /:$var\#/i) { $_ =~ /:$var\#([^:]*)/; $res = $1; last; } # if ($found_section_flag && /:$var[#=]/i) # { # $_ =~ /:$var[#=]([^:]*)/; # $res = $1; # last; # } } &gst_file_close ($fd); return $res; } sub gst_parse_cap_bool { my ($file, $section, $var) = @_; my ($fd, $res, $line); my $found_section_flag = 0; $fd = &gst_file_open_read_from_names ($file); $res = 0; while (($line = &gst_parse_ini_line_read ($fd)) != -1) { $_ = $$line; next if (/^$/); if (/^$section[:|]/i) { $found_section_flag = 1; } if ($found_section_flag && /:$var[:\#=]/i) { $res = 1; last; } } &gst_file_close ($fd); return $res; } # Load a printcap file to buffer, join \ lines and split them back up into a # 'one option, printtool comment or section name per line' format. sub gst_parse_printcap_buffer_load { my ($file) = @_; my ($inbuf, @outbuf); $inbuf = &gst_file_buffer_load ($file); &gst_file_buffer_join_lines ($inbuf); for $i (@$inbuf) { my ($comment) = (""); chomp $i; $comment = $1 if $i =~ s/^([ \t]*[\#].*)//; if ($i ne "") { my @line = split /:/, $i; if ($i =~ /^[a-z0-9]+/i) { push @outbuf, ($line [0] . ":\n"); shift @line; } for $elem (@line) { $elem =~ s/^[ \t]//; $elem =~ s/[ \t]$//; if ($elem ne "") { push @outbuf, ("\t:$elem:\n"); } } } elsif ($comment ne "") { push @outbuf, ($comment . "\n"); } else { push @outbuf, "\n"; } } return \@outbuf; } # Find next printer definition, returning (printtool-comment-lineno, stanza-name-lineno). sub gst_parse_printcap_get_next_stanza { my ($buf, $line_no) = @_; my ($last_printtool_line) = (-1); while ($line_no <= $#$buf) { if ($$buf [$line_no] =~ /^\#\#PRINTTOOL3\#\#/) { $last_printtool_line = $line_no; } elsif ($$buf [$line_no] =~ /^[a-z0-9]+/i) { return ($last_printtool_line, $line_no); } $line_no++; } return (-1, -1); } # Find next printer option. sub gst_parse_printcap_get_next_option { my ($buf, $line_no) = @_; while ($line_no <= $#$buf) { if ($$buf [$line_no] =~ /^\#\#PRINTTOOL3\#\#/ || $$buf [$line_no] =~ /^[a-z0-9]+/i) { last; } if ($$buf [$line_no] =~ /^\t:/) { return $line_no; } $line_no++; } return -1; } sub gst_parse_printcap_parse_stanza { my ($stanza) = @_; my ($key); $key = $1 if $stanza =~ /^([a-z0-9]+)/i; return $key; } sub gst_parse_printcap_parse_option { my ($option) = @_; my ($key, $value); $key = $1 if $option =~ /^\t:([a-z0-9]+)/i; $value = $1 if $option =~ /^\t:[a-z0-9]+[\#=]([a-z0-9\/_-]*)/i; return ($key, $value); } # Locate stanza line for $printer in $buf, starting at $line_no. sub gst_parse_printcap_find_stanza { my ($buf, $line_no, $printer) = @_; my ($printtool_line_no, $found_printer); while ((($printtool_line_no, $line_no) = &gst_parse_printcap_get_next_stanza ($buf, $line_no))) { if ($line_no == -1) { last; } $found_printer = &gst_parse_printcap_parse_stanza ($$buf [$line_no]); return ($printtool_line_no, $line_no) if ($found_printer eq $printer); $line_no++; } return (-1, -1); } # Search buffer for option with key $key, starting # at $line_no position. Return line number, or -1 if not found. sub gst_parse_printcap_find_option { my ($buf, $line_no, $key) = @_; my $found_key; while (($line_no = &gst_parse_printcap_get_next_option ($buf, $line_no)) != -1) { ($found_key) = &gst_parse_printcap_parse_option ($$buf [$line_no]); return $line_no if ($found_key eq $key); $line_no++; } return -1; } # High-level API. sub gst_parse_printcap { my ($file, $section, $var) = @_; my ($printtool_line_no, $stanza_line_no, $option_line_no); my ($buf); my ($key, $value); $buf = &gst_parse_printcap_buffer_load ($file); ($printtool_line_no, $stanza_line_no) = &gst_parse_printcap_find_stanza ($buf, 0, $section); return undef if ($stanza_line_no == -1); $option_line_no = &gst_parse_printcap_find_option ($buf, $stanza_line_no + 1, $var); return undef if ($option_line_no == -1); ($key, $value) = &gst_parse_printcap_parse_option ($$buf [$option_line_no]); return $value; } # High-level API. sub gst_parse_printcap_bool { my ($file, $section, $var) = @_; my ($printtool_line_no, $stanza_line_no, $option_line_no); my ($buf); my ($key, $value); $buf = &gst_parse_printcap_buffer_load ($file); ($printtool_line_no, $stanza_line_no) = &gst_parse_printcap_find_stanza ($buf, 0, $section); return 0 if ($stanza_line_no == -1); $option_line_no = &gst_parse_printcap_find_option ($buf, $stanza_line_no + 1, $var); return 0 if ($option_line_no == -1); return 1; } # Debian interfaces(5) states that files starting with # are comments. # Also, leading and trailing spaces are ignored. sub gst_parse_interfaces_line_clean { $_ = $_[0]; chomp; s/^[ \t]+//; s/^\#.*//; s/[ \t]+$//; return $_; } # interfaces(5) also states that \ line continuation is possible. sub gst_parse_interfaces_line_read { my $fd = $_[0]; my $l; $l = <$fd>; return -1 if ($l eq undef); $l = &gst_parse_interfaces_line_clean ($l); while ($l =~ /\\$/) { $l =~ s/\\$//; $l .= &gst_parse_interfaces_line_clean (scalar <$fd>); } return \$l; } # Read lines until a stanza, a line starting with $stanza_type is found. # Return ref to an array with the stanza params split. sub gst_parse_interfaces_get_next_stanza { my ($fd, $stanza_type) = @_; my $line; while (($line = &gst_parse_interfaces_line_read ($fd)) != -1) { $_ = $$line; if (/^$stanza_type[ \t]+[^ \t]/) { s/^$stanza_type[ \t]+//; return [ split ("[ \t]+", $_) ]; } } return -1; } # Read lines until a line not recognized as a stanza is # found, and split in a "tuple" of key/value. sub gst_parse_interfaces_get_next_option { my $fd = $_[0]; my $line; while (($line = &gst_parse_interfaces_line_read ($fd)) != -1) { $_ = $$line; next if /^$/; return [ split ("[ \t]+", $_, 2) ] if (!/^iface[ \t]/); return -1; } return -1; } # Get all stanzas from file. Return array. sub gst_parse_interfaces_stanzas { my ($file, $stanza_type) = @_; my ($fd, @res); $fd = &gst_file_open_read_from_names ($file); $res = undef; while (($_ = &gst_parse_interfaces_get_next_stanza ($fd, $stanza_type)) != -1) { push @res, $_; } &gst_file_close ($fd); return @res; } # Find stanza for $iface in $file, and return # tuple for option with $key. Return -1 if unexisting. sub gst_parse_interfaces_option_tuple { my ($file, $iface, $key, $all) = @_; my ($fd, @res); $fd = &gst_file_open_read_from_names ($file); while (($stanza = &gst_parse_interfaces_get_next_stanza ($fd, "iface")) != -1) { if ($$stanza[0] eq $iface) { while (($tuple = &gst_parse_interfaces_get_next_option ($fd)) != -1) { if ($$tuple[0] =~ /$key/) { return $tuple if !$all; push @res, $tuple; } } return -1 if !$all; } } return @res if $all; return -1; } # Go get option $kw for $iface stanza. If found, # return 1 (true), else, false. sub gst_parse_interfaces_option_kw { my ($file, $iface, $kw) = @_; my $tuple; &gst_report_enter (); &gst_report ("parse_ifaces_kw", $kw, $file); $tuple = &gst_parse_interfaces_option_tuple ($file, $iface, $kw); &gst_report_leave (); if ($tuple != -1) { &gst_report ("parse_ifaces_kw_strange", $iface, $file) if ($$tuple[1] ne ""); return 1; } return 0; } # For such keywords as noauto, whose existence means # a false value. sub gst_parse_interfaces_option_kw_not { my ($file, $iface, $kw) = @_; return &gst_parse_interfaces_option_kw ($file, $iface, $kw)? 0 : 1; } # Go get option $key for $iface in $file and return value. sub gst_parse_interfaces_option_str { my ($file, $iface, $key) = @_; my $tuple; &gst_report_enter (); &gst_report ("parse_ifaces_str", $kw, $file); $tuple = &gst_parse_interfaces_option_tuple ($file, $iface, $key); &gst_report_leave (); if ($tuple != -1) { return $$tuple[1]; } return undef; } # Implementing pump(8) pump.conf file format parser. # May be useful for dhcpd too. sub gst_parse_pump_get_next_option { my ($fd) = @_; my $line; while (($line = &gst_parse_interfaces_line_read ($fd)) != -1) { $line = $$line; if ($line ne "") { return [ split ("[ \t]+", $line, 2) ]; } } return -1; } sub gst_parse_pump_get_device { my ($fd, $iface) = @_; my ($opt); while (($opt = &gst_parse_pump_get_next_option ($fd)) != -1) { if ($$opt[0] eq "device") { $$opt[1] =~ s/[ \t]*\{//; return 1 if $$opt[1] eq $iface; } } return 0; } sub gst_parse_pump_get_iface_option_ref { my ($file, $iface, $key) = @_; my ($fd, $opt, $ret); $fd = &gst_file_open_read_from_names ($file); if (&gst_parse_pump_get_device ($fd, $iface)) { while (($opt = &gst_parse_pump_get_next_option ($fd)) != -1) { if ($$opt[0] eq $key) { $ret = &gst_parse_shell_unescape ($$opt[1]); return \$ret; } return -1 if ($$opt[0] eq "}"); } } return -1; } sub gst_parse_pump_get_iface_kw { my ($file, $iface, $key) = @_; my ($ret); return 1 if &gst_parse_pump_get_iface_option_ref ($file, $iface, $key) != -1; return 0; } sub gst_parse_pump_get_iface_kw_not { my ($file, $iface, $key) = @_; return 0 if &gst_parse_pump_get_iface_option_ref ($file, $iface, $key) != -1; return 1; } # Read a variable out of an XML document. The varpath is the '/'-separated path to the # XML tag. If the name of a property is passed, that property of the leaf tag is read, # otherwise the tag's PCDATA. sub gst_parse_xml { my ($file, $varpath, $property) = @_; my ($model, $branch); ($model) = &gst_xml_model_scan ($file); $branch = &gst_xml_model_find ($model, $varpath); if ($branch) { return &gst_xml_model_get_attribute ($branch, $property) if $property ne ""; return &gst_xml_model_get_pcdata ($branch); } return undef; } sub gst_parse_xml_child_names { my ($file, $varpath) = @_; my ($model, $branch, @tqchildren); ($model) = &gst_xml_model_scan ($file); $branch = &gst_xml_model_find ($model, $varpath); if (!$branch) { return @tqchildren; } my @list = @$branch; shift @list; # Attributes while (@list) { if ($list [0] ne "__unparsed__" && $list [0] ne "0") { push @tqchildren, shift @list; } else { shift @list; } shift @list; } return @tqchildren; } sub gst_parse_alchemist { my ($file, $varpath) = @_; $varpath = "/adm_context/datatree/" . $varpath; return &gst_parse_xml ($file, $varpath, "VALUE"); } sub gst_parse_alchemist_print { my ($file, $printer, $varpath) = @_; $varpath = "printconf/print_queues/" . $printer . "/" . $varpath; return &gst_parse_alchemist ($file, $varpath); } sub gst_parse_alchemist_print_option { my ($file, $printer, $name) = @_; my ($varpath, $model, $branch, $fd, $options, $option); ($model) = &gst_xml_model_scan ($file); $branch = &gst_xml_model_find ($model, "/adm_context/datatree/printconf/print_queues/" . $printer . "/filter_data/foomatic_defaults"); return undef if (!$branch); $options = &gst_xml_model_get_tqchildren ($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; } } return undef if (!$option); my $node = &gst_xml_model_find ($option, "default"); return undef if (!$node); return &gst_xml_model_get_attribute ($node, "VALUE"); } # extracts hostname from a fully qualified hostname # contained in a file sub gst_parse_fq_hostname { my ($file) = @_; my ($ret); $ret = &gst_parse_line_first ($file); $ret =~ s/\..*//; #remove domain return $ret; } # extracts domain from a fully qualified hostname # contained in a file sub gst_parse_fq_domain { my ($file) = @_; my ($ret); $ret = &gst_parse_line_first ($file); $ret =~ s/^[^\.]*\.//; return $ret; } sub gst_parse_rcinet1conf { my ($file, $iface, $kw) = @_; my ($line); $iface =~ s/eth//; #we must double escape those [] $line = "$kw\\[$iface\\]"; return &gst_parse_sh ($file, $line); } sub gst_parse_rcinet1conf_bool { my ($file, $iface, $kw) = @_; my ($ret); $ret = &gst_parse_rcinet1conf ($file, $iface, $kw); return undef if ($ret eq undef); return (&gst_util_read_boolean ($ret)? 1: 0); } sub gst_parse_wireless_opts { my ($file, $iface, $proc, $kw) = @_; my $ifaces = &$proc (); my $found = 0; my $search = 1; my $val = ""; my $fd; foreach $i (@$ifaces) { $found = 1 if ($iface eq $i); } return undef if (!$found); $fd = &gst_file_open_read_from_names ($file); while (<$fd>) { $line = $_; if ($line =~ /^case/) { # we don't want to search inside the case $search = 0; } elsif ($line =~ /^esac/) { # continue searching $search = 1; } elsif (($line =~ /^[ \t]*$kw/ ) && ($search)) { $line =~ s/.*=//; if ($line =~ /"(.*)"/) { $line = $1; } $val = $line; } } &gst_file_close ($fd); return $val; } # function for parsing /etc/start_if.$iface files in FreeBSD sub gst_parse_startif { my ($file, $regex) = @_; my ($fd, $line, $val); $fd = &gst_file_open_read_from_names ($file); $val = undef; return undef if ($fd eq undef); while (<$fd>) { chomp; # ignore comments next if (/^\#/); if (/$regex/) { $val = $1; } } # remove double quote if ($val =~ /\"(.*)\"/) { $val = $1; } return $val; } # functions for parsing /etc/ppp/ppp.conf sections in FreeBSD sub gst_parse_pppconf_find_next_stanza { my ($buff, $line_no) = @_; $line_no = 0 if ($line_no eq undef); while ($$buff[$line_no] ne undef) { if ($$buff[$line_no] !~ /^[\#\n]/) { return $line_no if ($$buff[$line_no] =~ /^[^ \t]+/); } $line_no++; } return -1; } sub gst_parse_pppconf_find_stanza { my ($buff, $section) = @_; my ($line_no) = 0; while (($line_no = &gst_parse_pppconf_find_next_stanza ($buff, $line_no)) != -1) { return $line_no if ($$buff[$line_no] =~ /^$section\:/); $line_no++; } return -1; } sub gst_parse_pppconf_common { my ($file, $section, $key) = @_; my ($fd, $val); $fd = &gst_file_open_read_from_names ($file); return undef if ($fd eq undef); $val = undef; # First of all, we must find the line where the section begins while (<$fd>) { chomp; last if (/^$section\:[ \t]*/); } while (<$fd>) { chomp; # read until the next section arrives last if (/^[^ \t]/); next if (/^\#/); if (/^[ \t]+(add|set|enable|disable)[ \t]+$key/) { $val = $_; last; } } # this is done because commands can be multiline while (<$fd>) { last if (/^[^ \t]/); last if ($val !~ /\\$/); s/^[ \t]*/ /; $val =~ s/\\$//; $val .= $_; } &gst_file_close ($fd); if ($val eq undef) { return undef if ($section eq "default"); return &gst_parse_pppconf_common ($file, "default", $key); } else { $val =~ s/\#[^\#]*$//; $val =~ s/[ \t]*$//; $val =~ s/^[ \t]*//; return $val; } } sub gst_parse_pppconf { my ($file, $section, $key) = @_; my ($val); $val = &gst_parse_pppconf_common ($file, $section, $key); if ($val =~ /$key[ \t]+(.+)/) { return $1; } } sub gst_parse_pppconf_bool { my ($file, $section, $key) = @_; my ($val); $val = &gst_parse_pppconf_common ($file, $section, $key); return 1 if ($val ne undef); return 0; } sub gst_parse_pppconf_re { my ($file, $section, $key, $re) = @_; my ($val); $val = &gst_parse_pppconf_common ($file, $section, $key); if ($val =~ /$re/i) { return $1; } } sub gst_parse_confd_net { my ($file, $key) = @_; my ($str, $contents, $i); $contents = &gst_file_buffer_load ($file); for ($i = 0; $i <= scalar (@$contents); $i++) { # search for key if ($$contents[$i] =~ /^$key[ \t]*=[ \t]*\(/) { # contents can be multiline, # just get the first value do { $$contents[$i] =~ /\"([^\"]*)\"/; $str = $1; $i++; } while (!$str); } } return $str; } sub gst_parse_confd_net_re { my ($file, $key, $re) = @_; my ($str); $str = &gst_parse_confd_net ($file, $key); if ($str =~ /$re/i) { return $1; } }