ACC SHELL
#!/usr/bin/perl -w
#
# $Id: ag_fetchmailrc 40718 2007-09-03 13:57:20Z varkoly $
# Author: Martin Vidner <mvidner@suse.cz>
#
# An agent for parsing and writing fetchmailrc files.
# See fetchmailrc.txt for the format restrictions.
use ycp;
use strict;
use Fcntl; # O_* for sysopen
use Errno qw(ENOENT);
# Data model:
# all comments are joined: "# foo\n# bar\n"
my $comment;
# global options. strings.
# also contains unparsable items
my @globals;
# entries are maps with these keys, values are strings:
# enabled (boolean), server, protocol, remote_user, local_user, password,
# other_server_options, other_user_options
my @accounts;
# Read only, set to "true" if there are entries we could not parse.
# It is used to assure the user that we know there is unparsed data
# and that we will not lose it
my $have_unparsed;
my $filename = "/etc/fetchmailrc";
# return false in case if an error
sub parse_file ()
{
my $whole_file = "";
$comment = "";
@globals = ();
@accounts = ();
$have_unparsed = "false";
if (!open (FILE, $filename))
{
return 1 if ($! == ENOENT); # ok if it is not there
y2error ("$filename: $!");
return 0;
}
while (<FILE>)
{
chomp;
# we want to match a comment, but not a '#' in a string
m{
^( (?: [^\'\"\#]* | \'[^\']*\' | \"[^\"]*\" )* ) #"
( \# .* )? $
}x;
$whole_file .= "$1\n";
$comment .= "$2\n" if defined $2;
}
close (FILE);
# Now split it into server entries and global options at the semicolons.
# Comments can have semicolons but we've already removed them.
# Semicolons in strings must be escaped numerically.
my $stringre = "(?:\'[^\']*\'|\"[^\"]*\")";
my $i = 0;
my @statements = split /;/, $whole_file;
foreach my $statement (@statements)
{
++$i;
if ($statement =~ /^\s*$/s)
{
# empty statements are ok.
}
elsif ($statement =~ m{^\s*
(poll|server|skip) \s* ($stringre) \s* # $1 $2
protocol \s+ ([[:alnum:]]+) \s* # $3
( # anything except a colon, except in a string
(?: [^:\'\"]* | \'[^\']*\' | \"[^\"]*\" )* #"
) # $4
: \s*
user \s* ($stringre) \s* there \s+ # $5
with \s+ password \s* ($stringre) \s* # $6
is \s* ($stringre|\*) \s* here \s* # $7
(.*) # $8
}xso) # whitespace, dot matches \n, compile once
{
my $entry = {};
$entry->{enabled} = ($1 eq "skip") ? \ "false" : \ "true";
$entry->{server} = read_string ($2);
# we leave checking the validity to the ycp code
# to keep the list of protocols in one place.
# but it may prove to be a bad idea.
$entry->{protocol} = uc $3;
$entry->{other_server_options} = $4;
$entry->{remote_user} = read_string ($5);
$entry->{password} = read_string ($6);
# local_user: return * as "*" to allow multidrop
if( $7 eq '*' ) {
$entry->{local_user} = '*';
} else {
$entry->{local_user} = read_string ($7);
}
$entry->{other_user_options} = $8;
push @accounts, $entry;
}
else
#elsif ($statement =~ /^\s*(set\s+.*)\s*$/s)
{
# a global setting or an unrecognized statement
push @globals, $statement;
# does it look like a regular entry?
if ($statement =~ /^poll /m) #m: ^ matches after newlines
{
$have_unparsed = "true";
}
}
}
return 1;
}
sub read_string ($)
{
$_ = shift;
s/^[\'\"](.*)[\'\"]$/$1/ or return undef; #"
my $output = "";
for (;;)
{
# m/\G.../cg
# see perlop, Regexp Quote-Like Operators
# g:match multiple times,
# \G, start where last match left off,
# c: don't reset last match if this one failed
if (/\G\\\\/cg) { $output .= "\\"; }
elsif (/\G\\n/cg) { $output .= "\n"; }
elsif (/\G\\t/cg) { $output .= "\t"; }
elsif (/\G\\b/cg) { $output .= "\b"; }
elsif (/\G\\r/cg) { $output .= "\r"; }
elsif (/\G\\[xX]([[:xdigit:]]{1,2})/cg) { $output .= chr (hex $1); }
elsif (/\G\\0([0-7]{0,2})/cg) { $output .= chr (oct $1); }
elsif (/\G\\([0-9]{1,3})/cg) { $output .= chr ($1); }
elsif (/\G\\(.)/cg) { $output .= $1; }
elsif (/\G([^\\]+)/cg) { $output .= $1; }
else { last; }
}
return $output;
}
#TODO: move it out!
sub test_read_string ()
{
my $foo = <<'END';
"normal foo"
""
'a hex semicolon\x3B a tab\tbackslash\\ octal newline\012decimal newline\10'
END
foreach my $s (split /\n/, $foo)
{
print $s." '".read_string ($s)."'\n";
}
}
# #207305
sub get_fetchmail_user ()
{
my $user = qx'F=/etc/sysconfig/fetchmail; test -f $F && . $F; echo ${FETCHMAIL_USER:-fetchmail}';
chomp $user;
return $user;
}
sub write_string ($)
{
$_ = shift;
my @substrings = split /\\/, $_, -1;
foreach my $substring (@substrings)
{
$substring =~ s/;/\\59/g;# escape semicolons
$substring =~ s/"/\\"/g;# escape quotes
# escape control chars
$substring =~ s/([\000-\037])/sprintf "\\%03o",ord($1)/eg;
}
return '"'. join ("\\\\", @substrings) .'"';
}
sub write_file ()
{
sysopen (FILE, "$filename.YaST2.new", O_WRONLY | O_TRUNC | O_CREAT, 0600)
or return y2error ("Creating file"), 0;
if ($comment !~ /yast2-(config-)?mail/)
{
$comment .= "# Edit carefully, see /usr/share/doc/packages/yast2-mail/fetchmailrc.txt\n";
}
print FILE $comment;
foreach (@globals)
{
print FILE "$_;\n";
}
foreach my $entry (@accounts)
{
print FILE ((!defined($entry->{enabled}) || $entry->{enabled}) ? "poll ": "skip ");
print FILE write_string ($entry->{server});
print FILE " protocol ", $entry->{protocol};
print FILE " ", $entry->{other_server_options} || "";
print FILE ":";
print FILE " user ", write_string ($entry->{remote_user}), " there";
print FILE " with password ", write_string ($entry->{password});
if( $entry->{local_user} eq '*' ) {
print FILE " is * here ";
} else {
print FILE " is ", write_string ($entry->{local_user}), " here ";
}
print FILE $entry->{other_user_options} || "";
print FILE ";\n"
}
close (FILE);
if (-f $filename)
{
rename $filename, "$filename.YaST2.save" or return y2error ("Creating backup: $!"), 0;
}
rename "$filename.YaST2.new", $filename or return y2error ("Moving temp file: $!"), 0;
my $user = get_fetchmail_user ();
my $chown_out = qx"chown $user: $filename 2>&1";
if ($chown_out ne "")
{
return y2error ("Changing ownership to $user: $chown_out"), 0;
}
return 1;
}
#
# MAIN cycle
#
# read the agent arguments
$_ = <STDIN>;
# no input at all - simply exit
exit if ! defined $_;
# reply to the client (this actually gets eaten by the ScriptingAgent)
ycp::Return (undef);
print "\n";
my ($symbol, $config, @rest) = ycp::ParseTerm ($_);
if ($symbol ne "Fetchmail")
{
y2error ("The first command must be the configuration.(Seen '$_')");
exit;
}
else
{
$filename = $config->{"filename"};
}
my $file_ok = parse_file ();
while ( <STDIN> )
{
next if /^\s*$/;
my ($command, $path, $argument) = ycp::ParseCommand ($_);
if ($command eq "Dir")
{
if ($path eq ".")
{
ycp::Return (["comment", "globals", "accounts"]);
}
else
{
ycp::Return ([]);
}
}
elsif ($command eq "Write")
{
my $result = "true";
if ($path eq ".comment" && ! ref ($argument))
{
$comment = $argument;
}
elsif ($path eq ".globals" && ref ($argument) eq "ARRAY")
{
@globals = @{$argument};
}
elsif ($path eq ".accounts" && ref ($argument) eq "ARRAY")
{
@accounts = @{$argument};
}
elsif ($path eq "." && !defined ($argument))
{
$result = write_file () ? "true":"false";
}
else
{
y2error ("Wrong path $path or argument: ", ref ($argument));
$result = "false";
}
ycp::Return ($result);
}
elsif ($command eq "Read")
{
if (! $file_ok)
{
ycp::Return (undef);
}
elsif ($path eq ".comment")
{
ycp::Return ($comment, 1);
}
elsif ($path eq ".globals")
{
ycp::Return (\@globals, 1);
}
elsif ($path eq ".accounts")
{
ycp::Return (\@accounts, 1);
}
elsif ($path eq ".have_unparsed")
{
ycp::Return ($have_unparsed);
}
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 ("false");
}
print "\n";
}
ACC SHELL 2018