Viewing file:  syslog-ng-lib.pl (19.55 KB) -rwxr-xr-x
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
# Functions for parsing the syslog-ng config file
BEGIN { push(@INC, ".."); };
use WebminCore;
&init_config();
@log_flags = ( "final", "fallback", "catchall" );
# get_syslog_ng_version()
# Returns the version number for syslog-ng, or undef
sub get_syslog_ng_version
{
local $out = &backquote_command("$config{'syslogng_cmd'} -V 2>&1 </dev/null",1);
return $out =~ /syslog-ng\s+([0-9\.]+)/ ? $1 : undef;
}
sub supports_sun_streams
{
return $gconfig{'os_type'} eq 'solaris';
}
# get_config()
# Parses the syslog-ng config file into an array ref of objects
sub get_config
{
if (!scalar(@get_config_cache)) {
# First read file into tokens
@get_config_cache = &read_config_file($config{'syslogng_conf'});
}
return \@get_config_cache;
}
# read_config_file(file)
# Parses a config file into structures
sub read_config_file
{
local ($file) = @_;
local (@rv, @tok, @ltok, @lnum);
&open_readfile(CONF, $file);
local $lnum = 0;
local $cmode;
while($line = <CONF>) {
# strip comments
$line =~ s/\r|\n//g;
$line =~ s/#.*$//g; # Remove hash comment
$line =~ s/\/\/.*$//g if ($line !~ /".*\/\/.*"/);
$line =~ s/\/\*.*\*\///g; # Remove multi-line comment
$line =~ s/^\s*@.*$//g; # Remove @version line
while(1) {
if (!$cmode && $line =~ /\/\*/) {
# start of a C-style comment
$cmode = 1;
$line =~ s/\/\*.*$//g;
}
elsif ($cmode) {
if ($line =~ /\*\//) {
# end of comment
$cmode = 0;
$line =~ s/^.*\*\///g;
}
else { $line = ""; last; }
}
else { last; }
}
# split line into tokens
undef(@ltok);
while(1) {
if ($line =~ /^\s*\"([^"]*)"(.*)$/) {
# " quoted string
push(@ltok, $1); $line = $2;
}
elsif ($line =~ /^\s*\'([^']*)'(.*)$/) {
# ' quoted string
push(@ltok, $1); $line = $2;
}
elsif ($line =~ /^\s*([{};\(\),\.])(.*)$/) {
# regular word
push(@ltok, $1); $line = $2;
}
elsif ($line =~ /^\s*([0-9\[\]\-]+\.[0-9\[\]\-]+\.[0-9\[\]\-]+\.[0-9\[\]\-]+)(.*)$/) {
# IP address regexp
push(@ltok, $1); $line = $2;
}
elsif ($line =~ /^\s*(\d+\.\d+\.\d+\.\d+)(.*)$/) {
# IP address
push(@ltok, $1); $line = $2;
}
elsif ($line =~ /^\s*([^{};\(\) \t,\.]+)(.*)$/) {
# meta-character
push(@ltok, $1); $line = $2;
}
else { last; }
}
foreach my $t (@ltok) {
push(@tok, $t);
push(@lnum, $lnum);
}
$lnum++;
}
# parse tokens into data structures
local $i = 0;
local $j = 0;
while($i < @tok) {
local $str = &parse_struct(\@tok, \@lnum, \$i, $j++, $file);
if ($str) {
push(@rv, $str);
}
}
close(CONF);
return @rv;
}
# parse_struct(&tokens, &lines, &line_num, index, file)
# Reads from the given list of tokens, until one complete structure has been
# parsed. If this contains sub-structures, they are parsed too.
sub parse_struct
{
local (%str, $i, $j, $t, @vals, $str);
$i = ${$_[2]};
return undef if ($_[0]->[$i] eq ")"); # end of a parent expression
&error("Bad directive ",$_[0]->[$i]," at ",$_[1]->[$i])
if ($_[0]->[$i] !~ /^[a-z0-9_\-]+$/i);
$str{'name'} = lc($_[0]->[$i]);
$str{'line'} = $_[1]->[$i];
$str{'index'} = $_[3];
$str{'file'} = $_[4];
$i++;
if ($_[0]->[$i] eq "(") {
# A directive like: use_dns (no);
# or file("/dev/console" owner(root));
# Read the first value, and then sub-directives
$i++; # skip (
local @vals;
if ($_[0]->[$i] ne ")" && $_[0]->[$i+1] ne "(") {
push(@vals, $_[0]->[$i++]);
}
# Parse extra , or .. separated values after (
local $cont = 0;
while(1) {
if ($_[0]->[$i] eq ",") {
push(@vals, $_[0]->[$i++]);
$cont = 1;
}
elsif ($_[0]->[$i] eq "." && $_[0]->[$i+1] eq ".") {
push(@vals, "..");
if ($_[0]->[$i+2] eq ".") {
$i++; # Three dots!
}
$i += 2;
$cont = 1;
}
elsif ($cont) {
push(@vals, $_[0]->[$i++]);
$cont = 0;
}
else {
last;
}
}
$str{'value'} = $vals[0];
$str{'values'} = \@vals;
local (@mems, $j);
$j = 0;
while($_[0]->[$i] ne ")") {
if (!defined($_[0]->[$i])) { ${$_[2]} = $i; return undef; }
local $str = &parse_struct($_[0], $_[1], \$i, $j++, $_[4]);
push(@mems, $str);
$i--; # sub-directives don't have a ; at the end
}
$str{'type'} = 0;
$str{'members'} = \@mems;
$i++; # skip the )
$i++; # skip the ;
}
else {
# A directive with children, like: foo bar { smeg(spod); };
# These may also form a boolean expression, like :
# level(info) or level(debug);
# Or even :
# (level(info) or level(debug)) and facility(local7);
while($_[0]->[$i] ne "{") {
# Parse stuff before {
push(@vals, $_[0]->[$i++]);
}
$str{'values'} = \@vals;
$str{'value'} = $vals[0];
$i++; # skip the {
# Parse the sub-structures
local(@mems, $j);
$str{'type'} = 1;
$j = 0;
while($_[0]->[$i] ne "}") {
if (!defined($_[0]->[$i])) { ${$_[2]} = $i; return undef; }
if ($_[0]->[$i] eq "(" || $_[0]->[$i] eq ")") {
# Start of a sub-expression
push(@mems, $_[0]->[$i++]);
}
elsif ($_[0]->[$i] eq "and" || $_[0]->[$i] eq "or" ||
$_[0]->[$i] eq "not") {
# A separator between directives
push(@mems, $_[0]->[$i++]);
}
elsif ($_[0]->[$i] eq ";") {
# Left-over ; , in an expression like level(foo));
$i++;
}
else {
# An actual directive
local $str = &parse_struct($_[0], $_[1], \$i, $j++, $_[4]);
push(@mems, $str);
if ($_[0]->[$i-1] ne ";") {
# This wasn't the last directive
$i--;
$str{'partial'} = 1;
}
}
}
$str{'members'} = \@mems;
$i += 2; # skip trailing } and ;
}
$str{'eline'} = $_[1]->[$i-1]; # ending line is the line number the trailing
# ; is on
${$_[2]} = $i;
return \%str;
}
# save_directive(&config, &parent, name|&old, &new, no-write)
# Updates, creates or deletes a directive in the syslog-ng config
sub save_directive
{
local ($conf, $parent, $name, $value, $nowrite) = @_;
local $x;
local $new = !$value ? undef : ref($value) ? $value :
{ 'name' => $name,
'values' => [ $value ],
'type' => 0 };
# Read the config file and work out the lines used
local $lref;
$lref = &read_file_lines($config{'syslogng_conf'}) if (!$nowrite);
local ($mems, $memseline);
if ($parent) {
$mems = $parent->{'members'};
$memseline = $parent->{'eline'};
}
else {
$mems = $conf;
$memseline = 0;
foreach my $c (@$conf) {
$memseline = $c->{'eline'} if ($c->{'eline'} > $memseline);
}
}
local $old = !$name ? undef : ref($name) ? $name : scalar(&find($name, $mems));
local ($idx, $oldlen, $newlen, @lines);
if ($old) {
$idx = &indexof($old, @$mems);
$idx >= 0 || &error("Failed to find $old in array of ",scalar(@$mems));
$oldlen = $old->{'eline'} - $old->{'line'} + 1;
}
if ($new) {
@lines = &directive_lines($new);
$newlen = scalar(@lines);
}
if ($old && $new) {
# Update the directive
$new->{'line'} = $old->{'line'};
$new->{'eline'} = $new->{'line'}+$newlen-1;
if ($new != $old) {
# Replace in config
local $idx = &indexof($old, @$mems);
$mems->[$idx] = $new;
}
if (!$nowrite) {
# Update it in the file
&renumber($conf, $new->{'line'}, $newlen - $oldlen);
splice(@$lref, $old->{'line'}, $oldlen, @lines);
}
$mems[$idx] = $new;
}
elsif ($old && !$new) {
# Remove the directive
splice(@$mems, $idx, 1);
if (!$nowrite) {
# Remove from the file
&renumber($conf, $old->{'line'}, -$oldlen);
splice(@$lref, $old->{'line'}, $oldlen);
}
}
elsif (!$old && $new) {
# Add the directive
$new->{'line'} = $memseline+1;
$new->{'eline'} = $memseline+$newlen;
if (!$nowrite) {
# Insert into the file
&renumber($conf, $new->{'line'}, $newlen);
splice(@$lref, $new->{'line'}, 0, @lines);
}
push(@$mems, $new);
}
&flush_file_lines($config{'syslogng_conf'}) if (!$nowrite);
}
# save_multiple_directives(&conf, &parent, &oldlist, &newlist, no-write)
# A convenience function to update multiple directives at once
sub save_multiple_directives
{
local ($conf, $parent, $oldlist, $newlist, $nowrite) = @_;
for(my $i=0; $i<@$oldlist || $i<@$newlist; $i++) {
local $what = $oldlist->[$i] || $newlist->[$i];
&save_directive($conf, $parent, $oldlist->[$i], $newlist->[$i],
$nowrite);
}
}
# renumber(&conf, line, offset)
# Changes the line numbers of all directives AFTER the given line
sub renumber
{
local ($conf, $line, $offset) = @_;
foreach my $c (@$conf) {
$c->{'line'} += $offset if ($c->{'line'} > $line);
$c->{'eline'} += $offset if ($c->{'eline'} > $line);
&renumber($c->{'members'}, $line, $offset) if ($c->{'members'});
}
}
# directive_lines(&dir)
# Returns an array of lines used by some directive, which may be a single
# value, or have sub-members
sub directive_lines
{
local ($dir) = @_;
local @rv;
if ($dir->{'type'} == 0) {
# A directive like use_dns(no); or file("/dev/console" owner(root));
local $line = $dir->{'name'}."(";
foreach my $v (@{$dir->{'values'}}) {
$line .= "ed_value($v)." ";
}
$line =~ s/\s+$//;
foreach my $m (@{$dir->{'members'}}) {
local ($mline) = &directive_lines($m);
$mline =~ s/;$//;
$line .= " ".$mline;
}
$line .= ");";
push(@rv, $line);
}
elsif ($dir->{'type'} == 1) {
# A directive with children, like: foo bar { smeg(spod); };
local $line = $dir->{'name'};
foreach my $v (@{$dir->{'values'}}) {
$line .= " "."ed_value($v);
}
$line .= " {";
push(@rv, $line);
local @w;
foreach my $m (@{$dir->{'members'}}) {
if (ref($m)) {
# An actual directive
local @mlines = &directive_lines($m);
push(@w, @mlines);
}
else {
# A separator word
if (@w) {
# Previous one doesn't need a ;
$w[$#w] =~ s/\s*;\s*$//;
}
push(@w, $m);
}
}
if ($dir->{'name'} eq 'filter') {
# All one one line
local $line = join(" ", @w);
$line .= ";" if ($line && $line !~ /\s*;\s*$/);
push(@rv, " ".$line);
}
else {
# Each directive is on its own line
push(@rv, map { " ".$_ } @w);
}
push(@rv, " };");
}
return @rv;
}
# quoted_value(string)
# Returns some string with quotes around it, if needed
sub quoted_value
{
local ($str) = @_;
return $str =~ /^[a-z\_][a-z0-9\_]*$/i ? $str :
$str =~ /^\d+\.\d+\.\d+\.\d+$/ ? $str :
$str =~ /^[0-9\[\]\-]+\.[0-9\[\]\-]+\.[0-9\[\]\-]+\.[0-9\[\]\-]+$/ ? $str :
$str eq "," || $str eq ".." ? $str :
$str =~ /^\d+$/ ? $str :
$str =~ /\"/ ? "'$str'" : "\"$str\"";
}
# find(name, &array)
sub find
{
local($c, @rv);
foreach $c (@{$_[1]}) {
if ($c->{'name'} eq $_[0]) {
push(@rv, $c);
}
}
return @rv ? wantarray ? @rv : $rv[0]
: wantarray ? () : undef;
}
# find_value(name, &array)
sub find_value
{
local(@v);
@v = &find($_[0], $_[1]);
if (!@v) { return undef; }
elsif (wantarray) { return map { $_->{'value'} } @v; }
else { return $v[0]->{'value'}; }
}
sub is_syslog_ng_running
{
if ($config{'pid_file'}) {
return &check_pid_file($config{'pid_file'});
}
else {
return &find_byname("syslog-ng");
}
}
# nice_destination_type(&dest)
# Returns a human-readable destination type
sub nice_destination_type
{
local ($d) = @_;
local $file = &find_value("file", $d->{'members'});
local $usertty = &find_value("usertty", $d->{'members'});
local $program = &find_value("program", $d->{'members'});
local $pipe = &find_value("pipe", $d->{'members'});
local $udp = &find_value("udp", $d->{'members'});
local $tcp = &find_value("tcp", $d->{'members'});
local $dgram = &find_value("unix-dgram", $d->{'members'});
local $stream = &find_value("unix-stream", $d->{'members'});
return $file ? ($text{'destinations_typef'}, 0) :
$usertty ? ($text{'destinations_typeu'}, 1) :
$program ? ($text{'destinations_typep'}, 2) :
$pipe ? ($text{'destinations_typei'}, 3) :
$udp ? ($text{'destinations_typed'}, 4) :
$tcp ? ($text{'destinations_typet'}, 5) :
$dgram ? ($text{'destinations_typeg'}, 6) :
$stream ? ($text{'destinations_types'}, 7) : (undef, -1);
}
# nice_destination_file(&dest)
# Returns a human-readable destination filename / hostname / etc
sub nice_destination_file
{
local ($d) = @_;
local $file = &find_value("file", $d->{'members'});
local $usertty = &find_value("usertty", $d->{'members'});
local $program = &find_value("program", $d->{'members'});
local $pipe = &find_value("pipe", $d->{'members'});
local $udp = &find_value("udp", $d->{'members'});
local $tcp = &find_value("tcp", $d->{'members'});
local $dgram = &find_value("unix-dgram", $d->{'members'});
local $stream = &find_value("unix-stream", $d->{'members'});
return $file ? "<tt>$file</tt>" :
$program ? "<tt>$program</tt>" :
$pipe ? "<tt>$pipe</tt>" :
$tcp ? &text('destinations_host', "<tt>$tcp</tt>") :
$udp ? &text('destinations_host', "<tt>$udp</tt>") :
$dgram ? "<tt>$dgram</tt>" :
$stream ? "<tt>$stream</tt>" :
$usertty eq "*" ? $text{'destinations_allusers'} :
$usertty ? &text('destinations_users', "<tt>$usertty</tt>") :
undef;
}
sub nice_source_desc
{
local ($source) = @_;
local @rv;
local $internal = &find("internal", $source->{'members'});
if ($internal) {
push(@rv, $text{'sources_typei'});
}
foreach my $t ("unix-stream", "unix-dgram") {
local $unix = &find($t, $source->{'members'});
local $msg = $t eq "unix-stream" ? 'sources_types' : 'sources_typed';
if ($unix) {
push(@rv, $text{$msg}." <tt>$unix->{'value'}</tt>");
}
}
foreach my $t ('tcp', 'udp') {
local $net = &find($t, $source->{'members'});
local $msg = $t eq "tcp" ? 'sources_typet' : 'sources_typeu';
if ($net) {
push(@rv, $text{$msg});
}
}
local $file = &find("file", $source->{'members'});
if ($file) {
push(@rv, $text{'sources_typef'}." <tt>$file->{'value'}</tt>");
}
local $pipe = &find("pipe", $source->{'members'});
if ($pipe) {
push(@rv, $text{'sources_typep'}." <tt>$pipe->{'value'}</tt>");
}
local $sun_streams = &find("sun-streams", $source->{'members'});
if ($sun_streams) {
push(@rv, $text{'sources_typen'}." <tt>$sun_streams->{'value'}</tt>");
}
return join(", ", @rv);
}
# check_dependencies(type, name)
# Returns a list of log objects that use some named source, destination or
# filter.
sub check_dependencies
{
local ($type, $name) = @_;
local $conf = &get_config();
local @logs = &find("log", $conf);
local @rv;
foreach my $l (@logs) {
local @deps = &find($type, $l->{'members'});
foreach my $d (@deps) {
if ($d->{'value'} eq $name) {
push(@rv, $l);
last;
}
}
}
return @rv;
}
# rename_dependencies(type, old, new)
# Updates any log objects that use the old named type to use the new
sub rename_dependencies
{
local ($type, $oldname, $newname) = @_;
#return if ($oldname eq $newname);
local $conf = &get_config();
local @logs = &find("log", $conf);
local @rv;
foreach my $l (@logs) {
local @deps = &find($type, $l->{'members'});
local $changed = 0;
foreach my $d (@deps) {
if ($d->{'value'} eq $oldname) {
$d->{'values'} = [ $newname ];
#&save_directive($conf, $l, $d, $d, 1);
$changed = 1;
}
}
if ($changed) {
&save_directive($conf, undef, $l, $l, 0);
}
}
}
# all_log_files(file)
# Given a filename, returns all rotated versions, ordered by oldest first
sub all_log_files
{
$_[0] =~ /^(.*)\/([^\/]+)$/;
local $dir = $1;
local $base = $2;
local ($f, @rv);
opendir(DIR, &translate_filename($dir));
foreach $f (readdir(DIR)) {
local $trans = &translate_filename("$dir/$f");
if ($f =~ /^\Q$base\E/ && -f $trans) {
push(@rv, "$dir/$f");
$mtime{"$dir/$f"} = [ stat($trans) ];
}
}
closedir(DIR);
return sort { $mtime{$a}->[9] <=> $mtime{$b}->[9] } @rv;
}
# catter_command(file)
# Given a file that may be compressed, returns the command to output it in
# plain text, or undef if impossible
sub catter_command
{
local ($l) = @_;
local $q = quotemeta($l);
if ($l =~ /\.gz$/i) {
return &has_command("gunzip") ? "gunzip -c $q" : undef;
}
elsif ($l =~ /\.Z$/i) {
return &has_command("uncompress") ? "uncompress -c $q" : undef;
}
elsif ($l =~ /\.bz2$/i) {
return &has_command("bunzip2") ? "bunzip2 -c $q" : undef;
}
else {
return "cat $q";
}
}
# nice_filter_desc(&filter)
# Returns a human-readable description for a filter
sub nice_filter_desc
{
local ($filter) = @_;
local @rv;
foreach my $m (@{$filter->{'members'}}) {
if (ref($m)) {
# A condition like level, facility or match
local @v = @{$m->{'values'}};
if ($m->{'name'} eq 'level') {
if ($v[1] eq "..") {
push(@rv, &text('filters_priorities',
$v[0], $v[2]));
}
elsif (@v > 1) {
@v = grep { $_ ne "," } @v;
push(@rv, &text('filters_priorities2',
scalar(@v)));
}
else {
push(@rv, &text('filters_priority', $v[0]));
}
}
elsif ($m->{'name'} eq 'facility') {
if (@v > 1) {
@v = grep { $_ ne "," } @v;
push(@rv, &text('filters_facilities',
scalar(@v)));
}
else {
push(@rv, &text('filters_facility', $v[0]));
}
}
elsif ($m->{'name'} eq 'match') {
push(@rv, &text('filters_match', $v[0]));
}
elsif ($m->{'name'} eq 'program') {
push(@rv, &text('filters_program', $v[0]));
}
elsif ($m->{'name'} eq 'host') {
push(@rv, &text('filters_host', $v[0]));
}
elsif ($m->{'name'} eq 'netmask') {
push(@rv, &text('filters_netmask', $v[0]));
}
else {
# Unknown type??
push(@rv, $m->{'name'}."(".join(",", @v).")");
}
}
else {
# An and/or keyword
push(@rv, $m);
}
}
if (@rv > 7) {
@rv = ( @rv[0..7], "..." );
}
return join(" ", @rv);
}
# list_priorities()
# Returns a list of all priorities
sub list_priorities
{
return ( 'debug', 'info', 'notice', 'warning',
'err', 'crit', 'alert', 'emerg' );
}
sub list_facilities
{
return ('auth', 'authpriv', 'cron', 'daemon', 'kern', 'lpr', 'mail', 'mark', 'news', 'syslog', 'user', 'uucp', 'local0', 'local1', 'local2', 'local3', 'local4', 'local5', 'local6', 'local7');
}
# apply_configuration()
# Activate the current config with a HUP signal
sub apply_configuration
{
local $pid = &check_pid_file($config{'pid_file'});
if ($pid) {
&kill_logged('HUP', $pid);
return undef;
}
else {
return $text{'apply_egone'};
}
}
# signal_syslog()
# Tell the syslog server to re-open it's log files
sub signal_syslog
{
&apply_configuration();
}
# start_syslog_ng()
# Attempts to start the syslog server process, and returns undef on success
# or an error message on failure
sub start_syslog_ng
{
local $cmd = $config{'start_cmd'} ||
"$config{'syslogng_cmd'} -f ".quotemeta($config{'syslogng_conf'}).
" -p ".quotemeta($config{'pid_file'});
local $out = &backquote_logged("$cmd 2>&1 </dev/null");
return $? ? "<pre>$out</pre>" : undef;
}
# stop_syslog_ng()
# Attempts to stop the syslog server process, and returns undef on success
# or an error message on failure
sub stop_syslog_ng
{
if ($config{'stop_cmd'}) {
local $out = &backquote_logged("$config{'stop_cmd'} 2>&1 </dev/null");
return $? ? "<pre>$out</pre>" : undef;
}
else {
local $pid = &check_pid_file($config{'pid_file'});
if ($pid) {
&kill_logged('TERM', $pid);
return undef;
}
else {
return $text{'apply_egone'};
}
}
}
# get_other_module_logs([module])
# Returns a list of logs supplied by other modules
sub get_other_module_logs
{
local ($mod) = @_;
local @rv;
local %done;
foreach my $minfo (&get_all_module_infos()) {
next if ($mod && $minfo->{'dir'} ne $mod);
next if (!$minfo->{'syslog'});
next if (!&foreign_installed($minfo->{'dir'}));
local $mdir = &module_root_directory($minfo->{'dir'});
next if (!-r "$mdir/syslog_logs.pl");
&foreign_require($minfo->{'dir'}, "syslog_logs.pl");
local $j = 0;
foreach my $l (&foreign_call($minfo->{'dir'}, "syslog_getlogs")) {
local $fc = $l->{'file'} || $l->{'cmd'};
next if ($done{$fc}++);
$l->{'minfo'} = $minfo;
$l->{'mod'} = $minfo->{'dir'};
$l->{'mindex'} = $j++;
push(@rv, $l);
}
}
@rv = sort { $a->{'minfo'}->{'desc'} cmp $b->{'minfo'}->{'desc'} } @rv;
local $i = 0;
foreach my $l (@rv) {
$l->{'index'} = $i++;
}
return @rv;
}
1;
|