home *** CD-ROM | disk | FTP | other *** search
- #!/usr/bin/perl -w
- #
- # $Id: ag_netd 33164 2006-09-27 08:42:24Z jsrain $
- # Author: Martin Vidner <mvidner@suse.cz>
- #
-
- use ycp;
- use strict;
- use File::Basename;
-
- my $debug = defined ($ARGV[0]) && $ARGV[0] =~ "^-.*d";
-
- sub DEBUG
- {
- print STDERR @_ if $debug;
- }
- DEBUG "DEBUG\n";
-
- # Testsuite hack:
- # Automake invokes dejagnu with an absolute srcdir :(
- # This will replace the current directory in file names by "./"
- # Turn it off by -n
- my $strip = ! (defined ($ARGV[0]) && $ARGV[0] =~ "^-.*n");
- my $pwd;
- if ($strip)
- {
- DEBUG "STRIP\n";
- # must use symlinks like make does
- # pwd alone calls /bin/pwd, we want the bash builtin
- $pwd = `bash -c pwd -L`;
- chomp $pwd;
- DEBUG "PWD: '$pwd'\n";
- }
- sub strip_pwd ($)
- {
- DEBUG "STRIP0: $_[0]\n";
- $_[0] =~ s{^$pwd/}{./}o if $strip;
- DEBUG "STRIP1: $_[0]\n";
- return $_[0];
- }
-
- my @services;
- # where new services are added
- my $dir_with_includes = "";
- my $base_file = "";
- # used for a warning about unsupported options
- my $message = "";
-
- package ycp;
- sub to_bool ($)
- {
- my $b = shift;
- return $b? \ "true" : \ "false";
- }
-
-
- package linefile;
- # a handle, a name and line number
- use IO::File;
-
- sub new ($$)
- {
- my $class = shift;
- my ($name, $mode) = @_;
- my $f = { "name" => $name,
- "lineno" => 0,
- "fh" => new IO::File ($name, $mode) };
- return bless ($f, $class);
- }
-
-
- package netd;
- # base of inetd and xinetd
- use ycp;
-
- # makes a hash (keyed by file names) of hashes (keyed by line numbers)
- # of changed services
- # exception: line -1 is a _list_ of new services
- sub get_changed (@)
- {
- my %ch = ();
- foreach my $s (@_)
- {
- next if (!$s->{changed});
- if (defined ($s->{iid}) && $s->{iid} =~ m/(\d+):(.*)/)
- {
- my ($line, $file) = ($1, $2);
- $ch{$file}->{$line} = $s;
- }
- else
- {
- y2debug "new $s->{service}";
- # Bug 26999: if we have encountered an "includedir",
- # create the new services there. The file name is
- # the "script" or "service" field.
- my $fname = filename_for_new_service ($s);
- push (@{$ch{$fname}->{-1}}, $s);
- }
- }
- return %ch;
- }
-
- sub filename_for_new_service ($)
- {
- my $s = shift;
- if ($dir_with_includes)
- {
- my $script = $s->{script} || $s->{service};
- return $dir_with_includes ."/".$script;
- }
- else
- {
- # no includes, use the main file
- return $base_file;
- }
- }
-
- sub parse_file ($)
- {
- my $class = shift;
- ::DEBUG ("$class\n");
- my $filename = ::strip_pwd (shift);
-
- use Errno qw(ENOENT);
-
- my $file = new linefile ($filename, "r");
- if (! $file->{fh})
- {
- # return 1 if ($! == ENOENT); # ok if it is not there
- y2error ("$file->{name}: $!");
- return 0;
- }
-
- while (1)
- {
- my $service = $class->parse_service ($file);
- last if !defined ($service);
- if ($service->{is_defaults})
- {
- if ($service->{enabled} || $service->{disabled})
- {
- # TODO rework, must be translated!
- $message = "Enabling and disabling services\n"
- . "in the \"defaults\" section is ignored.";
- }
- }
- else
- {
- push (@services, $service);
- }
- # ::DEBUG ("tick\n");
- }
-
- $file->{fh}->close;
- return 1;
- }
-
- sub include_dir ($)
- {
- my $class = shift;
- ::DEBUG ("$class\n");
- my $dirname = shift;
- $dir_with_includes = $dirname; # for creating new services
- use IO::Dir;
- my $dir = new IO::Dir ($dirname);
- my @files;
- if (defined $dir)
- {
- while (defined ($_ = $dir->read ()))
- {
- push (@files, $_) unless m/\./ || m/~$/;
- }
- $dir->close ();
- }
- else
- {
- y2error "Cannot include dir '$dirname'";
- }
-
- foreach (sort @files)
- {
- $class->parse_file ("$dirname/$_");
- }
- }
-
- sub write_file ()
- {
- use IO::File;
- my $class = shift;
-
- my $ret = 1;
- my %changed_services = get_changed (@services);
- while (my ($filename, $lines) = each %changed_services)
- {
- # TODO guard against changed files
- my $ofilename = "$filename.tmp";
- # if we are creating a new file, $if->{fh} will be undef,
- # which is taken care of below
- my $if = new linefile ($filename, "r");
- my $OF = new IO::File (">$ofilename");
- if (! $OF)
- {
- y2error ("Opening '$ofilename' for writing: $!");
- $ret = 0;
- next; # continue with the next file
- }
-
- my @new_services = defined ($lines->{-1}) ? @{$lines->{-1}} : ();
- delete $lines->{-1};
-
- # copy the file, replacing services at specified lines by
- # changed ones
- my @linenos = sort keys %{$lines};
- y2debug "@linenos";
-
- # Be careful here not to read the line that starts the changed service
- # because then we would have to "unget" it in both implementations
- # of parse_service.
- # Therefore we don't use the traditional "while(<>) {...}" loop.
- # Loop rewritten to fix missing consecutive modified services (#24379).
- $if->{lineno} = 0;
- while (1)
- {
- # now $lineno is the line number of the contents of $_
- # and $_ or its replacement has been output
-
- if (defined ($linenos[0]) && $if->{lineno}+1 == $linenos[0])
- {
- # got there
- my $service = $lines->{shift @linenos};
- # this writes the new data,
- # "replace" copies the unknown data
- $class->write_service ($OF, $service)
- unless $service->{deleted};
- $class->parse_service ($if); #discard the old data
- }
- else
- {
- # read a line, allowing for a non-existent file
- if ($if->{fh})
- {
- $_ = $if->{fh}->getline;
- }
- else
- {
- $_ = undef;
- }
-
- if (!defined $_)
- {
- # On eof, the branch with parse_service will not be taken
- # because that would mean we think there are services
- # past eof. Even in that case, parse_service will simply
- # return and @linenos will be exhausted and we get here.
- last;
- }
- ++$if->{lineno};
- y2debug ($if->{name}, $if->{lineno}, "copy");
-
- print $OF $_;
- }
- }
-
- # can we add new services?
- foreach my $service (@new_services)
- {
- y2debug "NEW $service->{service}";
- $class->write_service ($OF, $service)
- unless $service->{deleted};
- }
-
- rename ($ofilename, $filename);
- }
- return $ret;
- }
-
- sub services_by_package ()
- {
- my $class = shift;
-
- open (OUT, ">/dev/fd/3");
- foreach my $s (@services)
- {
- # Get the program name - used to see whether a service is installed.
- # Assumedly multiple packages providing the same service will differ
- # in the program name.
- my $program = $s->{server};
- if ($program =~ m:/tcpd$:)
- {
- my @args = split (/\s+/, $s->{server_args});
- $program = shift (@args);
- }
- $program =~ s:^.*/::;
-
- # originally used TABs as delimiters,
- # but awk then misses an empty protocol
- print OUT "$s->{service},$s->{protocol},$program\n";
- }
- close (OUT);
- }
-
-
- package inetd;
- @inetd::ISA = qw(netd);
- use ycp;
-
- # parses the next service, returns it or undef on EOF
- # does not attempt to read the next service!
- sub parse_service ($)
- {
- my $class = shift;
- ::DEBUG ("$class\n");
- y2debug ("parse_service");
-
- my $file = shift;
-
- my $service = undef;
- my $comment = "";
- my $reclineno = 0; # line at which a record (including comment) starts
- while (defined ($_ = $file->{fh}->getline))
- {
- ++$file->{lineno};
- y2debug ($file->{name}, $file->{lineno}, "parse");
-
- chomp;
- next if /^$/;
- $reclineno ||= $file->{lineno};
-
- # Try parsing also commented out lines
- my $enabled = 1;
- # TODO
- # spaces before #
-
- if (s/^#//)
- {
- $enabled = 0;
- }
- # leave $c intact for comment
- my $c = $_;
- s/^\s+//;
-
- # TODO test a truncated line
- my @fields = split (/\s+/);
- my ($service_ver, $socket_type, $protocol, $wait_max, $user_group,
- $server, @server_args) = @fields;
- if (!defined ($server) ||
- $socket_type !~ /dgram|stream|raw|rdm|seqpacket/)
- {
- if (!$enabled)
- {
- # tried to parse a disabled service, did not work out
- $comment .= "$c\n";
- }
- else
- {
- # TODO error? it is a damaged entry
- }
- next;
- }
- # the second variable of these pairs can be undef
- my ($service_name, $rpc_version) = split (/\//, $service_ver);
- $rpc_version ||= "";
- my ($wait, $nmax) = split (/\./, $wait_max);
- # "" is wrong, but the ycp code works around it
- # convert to numbers
- my $max = $nmax? \$nmax : "";
- my ($user, $group) = split (/[.:]/, $user_group);
- $group ||= "";
-
- # convert to booleans
- $enabled = ycp::to_bool ($enabled);
- $wait = ycp::to_bool ($wait eq "wait");
-
- $service =
- {
- "iid" => "$reclineno:$file->{name}",
- "script" => File::Basename::basename ($file->{name}),
-
- "enabled" => $enabled,
- "comment" => $comment,
- "service" => $service_name,
- "rpc_version" => $rpc_version,
- "socket_type" => $socket_type,
- "protocol" => $protocol,
- "wait" => $wait,
- "max" => $max,
- "user" => $user,
- "group" => $group,
- "server" => $server,
- "server_args" => join (" ", @server_args),
- };
- last;
- }
- return $service;
- }
-
- sub write_service ($$)
- {
- my $class = shift;
- ::DEBUG ("$class\n");
- y2debug ("write_service");
-
- my $f = shift;
- my $s = shift;
-
- foreach (split (/\n/, $s->{comment}))
- {
- print $f "#$_\n";
- }
-
- if (! $s->{enabled})
- {
- print $f "# ";
- }
-
- print $f $s->{service};
- print $f "/". $s->{rpc_version} if $s->{rpc_version};
- print $f " ";
-
- print $f $s->{socket_type}. " ";
- print $f $s->{protocol}. " ";
-
- print $f ($s->{wait}? "wait":"nowait");
- print $f ".". $s->{max} if $s->{max};
- print $f " ";
-
- print $f $s->{user};
- print $f ".". $s->{group} if $s->{group};
- print $f " ";
-
- print $f $s->{server};
- print $f " ". $s->{server_args} if $s->{server_args};
- print $f "\n";
- }
-
-
- package xinetd;
- @xinetd::ISA = qw(netd);
- use ycp;
-
- sub parse_service ($)
- {
- my $class = shift;
- ::DEBUG ("$class\n");
- y2debug ("parse_service");
-
- my $file = shift;
- my $service = undef;
- my $comment = "";
- my $comment_inside = ""; # usually commented out attributes
- my $reclineno = 0; # line at which a record (including comment) starts
- my $state = "init"; # "brace", "inside"
- my $in_defaults = 0;
- my $unparsed = "";
- while ($file && $file->{fh} && defined ($_ = $file->{fh}->getline))
- {
- ++$file->{lineno};
- y2debug ($file->{name}, $file->{lineno}, "parse");
-
- chomp;
- next if /^\s*$/;
- $reclineno ||= $file->{lineno};
-
- if (s/^\s*#//)
- {
- if ($state eq "inside")
- {
- $comment_inside .= "$_\n";
- }
- else
- {
- $comment .= "$_\n";
- }
- }
- else
- {
- if ($state eq "init")
- {
- if (/^\s*include\s+(\S+)/)
- {
- $class->parse_file ($1);
- $reclineno = 0;
- }
- elsif (/^\s*includedir\s+(\S+)/)
- {
- $class->include_dir ($1);
- # Bug 24270:
- # the include directive must not belong
- # to the following service
- $reclineno = 0;
- }
- elsif (/^\s*service\s+(\S+)/)
- {
- $service =
- {
- "service" => $1,
- "iid" => "$reclineno:$file->{name}",
- "script" => File::Basename::basename ($file->{name}),
- # default values:
- "enabled" => ycp::to_bool (1),
- "rpc_version" => "",
- "socket_type" => "MISSING", # mandatory
- "protocol" => "",
- "wait" => ycp::to_bool (0), # mandatory
- "user" => "",
- "group" => "",
- "server" => "",
- "server_args" => "",
- };
- $state = "brace";
- $in_defaults = 0;
- }
- elsif (/^\s*defaults\s*$/)
- {
- $service =
- {
- "is_defaults" => 1,
- };
- $state = "brace";
- $in_defaults = 1;
- }
- else
- {
- y2error ("Expecting \"service\" at ".
- "$file->{name}:$file->{lineno}");
- }
- }
- elsif ($state eq "brace")
- {
- if (/^\s*\{\s*$/)
- {
- $state = "inside";
- }
- else
- {
- y2error ("An opening brace ({) should follow a ".
- "\"service $service->{service}\" line. Seen $_.");
- # continue.
- }
- }
- elsif ($state eq "inside")
- {
- if (/^\s*\}\s*$/)
- {
- # wrap up
- $service->{comment} = $comment;
- $service->{comment_inside} = $comment_inside;
- $service->{unparsed} = $unparsed;
- last;
- }
- elsif (m{^\s*(\S+)\s*=\s*(.*?)\s*$})
- {
- my ($attribute, $value) = ($1, $2);
- if ($in_defaults)
- {
- if ($attribute =~ m{enabled|disabled})
- {
- $service->{$attribute} .= "$value ";
- }
- else
- {
- $unparsed .= "$_\n";
- }
- }
- else
- {
- # "disable" != "disabled"
- if ($attribute eq "disable")
- {
- $service->{enabled} = ycp::to_bool($value eq "no");
- }
- elsif ($attribute =~ m{rpc_version|
- socket_type|
- protocol|
- wait| # bool
- user|
- group|
- server|
- server_args
- }x)
- {
- if ($attribute eq "wait")
- {
- $value = ycp::to_bool ($value eq "yes");
- }
- $service->{$attribute} = $value;
- }
- else
- {
- $unparsed .= "$_\n";
- }
- }
- }
- else
- {
- $unparsed .= "$_\n";
- }
- }
- else
- {
- y2internal ("Unknown state $state.");
- $state = "inside"; # recover from the error
- }
- }
- }
- return $service;
- }
-
- sub write_item ($$$;$)
- {
- my ($f, $s, $attribute, $value) = @_;
- $value ||= $s->{$attribute};
- # there's #define FIELD_WIDTH 15 in itox.c
- printf $f "\t%-15s = %s\n", $attribute, $value;
- }
-
- sub write_opt_item ($$$)
- {
- my ($f, $s, $attribute) = @_;
- write_item ($f, $s, $attribute) if $s->{$attribute};
- }
-
- sub write_service ($$)
- {
- my $class = shift;
- ::DEBUG ("$class\n");
- y2debug ("write_service");
-
- my $f = shift;
- my $s = shift;
-
- foreach (split (/\n/, $s->{comment} || ""))
- {
- print $f "#$_\n";
- }
-
- print $f "service $s->{service}\n";
- print $f "{\n";
-
- foreach (split (/\n/, $s->{comment_inside} || ""))
- {
- print $f "#$_\n";
- }
-
- if (! $s->{enabled})
- {
- write_item $f, $s, "disable", "yes";
- }
- if ($s->{rpc_version})
- {
- $s->{type} ||= ""; # prevent undef
- $s->{type} .= " RPC" if ($s->{type} !~ /RPC/);
- write_item $f, $s, "rpc_version";
- }
- write_item $f, $s, "socket_type";
- write_opt_item $f, $s, "protocol";
- write_item $f, $s, "wait", ($s->{wait}? "yes":"no");
-
- write_opt_item $f, $s, "user";
- write_opt_item $f, $s, "group";
- write_opt_item $f, $s, "server";
- write_opt_item $f, $s, "server_args";
-
- write_opt_item $f, $s, "type";
- print $f $s->{unparsed} || "";
- print $f "}\n";
- }
-
-
- package main;
- #
- # MAIN cycle
- #
-
- my $netd;
- # if reading fails, defaulting to no services
- @services = ();
-
- while ( <STDIN> )
- {
- chomp;
- y2debug ("Got: ", $_);
- if (/^nil$/)
- {
- print "nil\n";
- next;
- }
-
- my ($command, @arguments) = ycp::ParseTerm ($_);
- if ($command =~ "Netd|Inetd|Xinetd")
- {
- # reply to the client (this actually gets eaten by the ScriptingAgent)
- ycp::Return (undef);
- print "\n";
- $netd = ($command eq "Xinetd")? "xinetd": "inetd";
- my $fn = shift @arguments || "/etc/$netd.conf";
-
- $base_file = strip_pwd ($fn);
-
- # parsing is done before Read (.services)
- # so that we can re-read the config if a new package is installed
- next;
- }
- # else it should be a regular command
- my $path = "";
- my $pathref = shift @arguments;
- if (defined $pathref)
- {
- if (ref($pathref) eq "SCALAR" && $$pathref =~ /^\./)
- {
- $path = $$pathref;
- }
- # 'result (nil)' is a standard command
- elsif ($command ne "result")
- {
- y2error ("The first argument is not a path. ('$pathref')");
- }
- }
- my $argument = shift @arguments;
- y2warning ("Superfluous command arguments ignored") if (@arguments > 0);
-
-
- if ($command eq "Dir")
- {
- if ($path eq ".")
- {
- ycp::Return (["message", "services"]);
- }
- elsif ($path eq ".services")
- {
- my @snames = map { $_->{service} } @services;
- ycp::Return ([ sort @snames ], 1);
- }
- else
- {
- ycp::Return ([]);
- }
- }
-
- elsif ($command eq "Write")
- {
- my $result = 1;
- if ($path eq ".services" && ref ($argument) eq "ARRAY")
- {
- @services = @{$argument};
- $result = $netd->write_file ();
- }
- else
- {
- y2error ("Wrong path $path or argument: ", ref ($argument));
- $result = 0;
- }
- ycp::Return (ycp::to_bool ($result));
- }
-
- elsif ($command eq "Read")
- {
- if ($path eq ".services")
- {
- # must clear before re-reading
- # but not in parse_file, that would break includedir
- @services = ();
- $netd->parse_file ($base_file);
- ycp::Return (\@services, 1);
- }
- elsif ($path eq ".message")
- {
- ycp::Return ($message, 1);
- $message = "";
- }
- else
- {
- y2error ("Unrecognized path! '$path'");
- ycp::Return (undef);
- }
- }
-
- # A special hack - write known services/protocols to fd3
- # Used for gathering a list of all available services by package
- elsif ($command eq "Execute")
- {
- if ($path eq ".sbp")
- {
- $netd->services_by_package ();
- ycp::Return ("true");
- }
- else
- {
- y2error ("Unrecognized path! '$path'");
- ycp::Return (undef);
- }
- }
-
- elsif ($command eq "result")
- {
- exit;
- }
-
- # Unknown command
- else
- {
- y2error ("Unknown instruction $command or argument: ", ref ($argument));
- ycp::Return (undef);
- }
- print "\n";
- }
-