X-Git-Url: https://vcs.fsf.org/?a=blobdiff_plain;f=src%2Fsrc%2Fexipick.src;h=e121c99c805af746a0b8827b2d2b5cf7cc9209fc;hb=2156b9e96e10dba65081dbc688a98bf42c26d868;hp=a2281f0da17417a6a018d192cd40e8c6f6f1f83a;hpb=48ab0b3cd8203744bd9f50765a81473bbbb93de1;p=exim.git diff --git a/src/src/exipick.src b/src/src/exipick.src index a2281f0da..e121c99c8 100644 --- a/src/src/exipick.src +++ b/src/src/exipick.src @@ -18,10 +18,11 @@ use strict; BEGIN { pop @INC if $INC[-1] eq '.' }; use Getopt::Long; use File::Basename; +use Pod::Usage; -my($p_name) = $0 =~ m|/?([^/]+)$|; +my $p_name = basename $0; my $p_version = "20100323.0"; -my $p_usage = "Usage: $p_name [--help|--version] (see --help for details)"; +my $p_usage = "Usage: $p_name [--help|--man|--version] (see --help for details)"; my $p_cp = < @@ -39,7 +40,6 @@ my $p_cp = < \$G::just_vars, # only display vars, no other info 'show-rules' => \$G::show_rules, # display compiled match rules 'show-tests' => \$G::show_tests, # display tests as applied to each message + 'man' => sub { pod2usage(-verbose => 2, -exit => 0, -noperldoc => system('perldoc -V >/dev/null 2>&1')) }, + 'help' => sub { pod2usage(-verbose => 1, -exit => 0) }, 'version' => sub { - print basename($0) . ": $0\n", + print "$p_name: $0\n", "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n", "perl(runtime): $]\n"; exit 0; }, -) || exit(1); +) or pod2usage; # if both freeze and thaw specified, only thaw as it is less destructive $G::freeze = undef if ($G::freeze && $G::thaw); @@ -900,109 +902,105 @@ sub _parse_header { $self->{_vars}{warning_count} = $2; $self->{_vars}{message_age} = time() - $self->{_vars}{received_time}; - while () { - chomp(); - if (/^(-\S+)\s*(.*$)/) { - my $tag = $1; - my $arg = $2; - if ($tag eq '-acl') { - my $t; - return(0) if ($arg !~ /^(\d+)\s(\d+)$/); - if ($1 < $Exim::SpoolFile::ACL_C_MAX_LEGACY) { - $t = "acl_c$1"; - } else { - $t = "acl_m" . ($1 - $Exim::SpoolFile::ACL_C_MAX_LEGACY); - } - read(I, $self->{_vars}{$t}, $2+1) || return(0); - chomp($self->{_vars}{$t}); - } elsif ($tag eq '-aclc') { - #return(0) if ($arg !~ /^(\d+)\s(\d+)$/); - return(0) if ($arg !~ /^(\S+)\s(\d+)$/); - my $t = "acl_c$1"; - read(I, $self->{_vars}{$t}, $2+1) || return(0); - chomp($self->{_vars}{$t}); - } elsif ($tag eq '-aclm') { - #return(0) if ($arg !~ /^(\d+)\s(\d+)$/); - return(0) if ($arg !~ /^(\S+)\s(\d+)$/); - my $t = "acl_m$1"; - read(I, $self->{_vars}{$t}, $2+1) || return(0); - chomp($self->{_vars}{$t}); - } elsif ($tag eq '-local') { - $self->{_vars}{sender_local} = 1; - } elsif ($tag eq '-localerror') { - $self->{_vars}{local_error_message} = 1; - } elsif ($tag eq '-local_scan') { - $self->{_vars}{local_scan_data} = $arg; - } elsif ($tag eq '-spam_score_int') { - $self->{_vars}{spam_score_int} = $arg; - $self->{_vars}{spam_score} = $arg / 10; - } elsif ($tag eq '-bmi_verdicts') { - $self->{_vars}{bmi_verdicts} = $arg; - } elsif ($tag eq '-host_lookup_deferred') { - $self->{_vars}{host_lookup_deferred} = 1; - } elsif ($tag eq '-host_lookup_failed') { - $self->{_vars}{host_lookup_failed} = 1; - } elsif ($tag eq '-body_linecount') { - $self->{_vars}{body_linecount} = $arg; - } elsif ($tag eq '-max_received_linelength') { - $self->{_vars}{max_received_linelength} = $arg; - } elsif ($tag eq '-body_zerocount') { - $self->{_vars}{body_zerocount} = $arg; - } elsif ($tag eq '-frozen') { - $self->{_vars}{deliver_freeze} = 1; - $self->{_vars}{deliver_frozen_at} = $arg; - } elsif ($tag eq '-allow_unqualified_recipient') { - $self->{_vars}{allow_unqualified_recipient} = 1; - } elsif ($tag eq '-allow_unqualified_sender') { - $self->{_vars}{allow_unqualified_sender} = 1; - } elsif ($tag eq '-deliver_firsttime') { - $self->{_vars}{deliver_firsttime} = 1; - $self->{_vars}{first_delivery} = 1; - } elsif ($tag eq '-manual_thaw') { - $self->{_vars}{deliver_manual_thaw} = 1; - $self->{_vars}{manually_thawed} = 1; - } elsif ($tag eq '-auth_id') { - $self->{_vars}{authenticated_id} = $arg; - } elsif ($tag eq '-auth_sender') { - $self->{_vars}{authenticated_sender} = $arg; - } elsif ($tag eq '-sender_set_untrusted') { - $self->{_vars}{sender_set_untrusted} = 1; - } elsif ($tag eq '-tls_certificate_verified') { - $self->{_vars}{tls_certificate_verified} = 1; - } elsif ($tag eq '-tls_cipher') { - $self->{_vars}{tls_cipher} = $arg; - } elsif ($tag eq '-tls_peerdn') { - $self->{_vars}{tls_peerdn} = $arg; - } elsif ($tag eq '-tls_sni') { - $self->{_vars}{tls_sni} = $arg; - } elsif ($tag eq '-host_address') { - $self->{_vars}{sender_host_port} = $self->_get_host_and_port(\$arg); - $self->{_vars}{sender_host_address} = $arg; - } elsif ($tag eq '-interface_address') { - $self->{_vars}{received_port} = - $self->{_vars}{interface_port} = $self->_get_host_and_port(\$arg); - $self->{_vars}{received_ip_address} = - $self->{_vars}{interface_address} = $arg; - } elsif ($tag eq '-active_hostname') { - $self->{_vars}{smtp_active_hostname} = $arg; - } elsif ($tag eq '-host_auth') { - $self->{_vars}{sender_host_authenticated} = $arg; - } elsif ($tag eq '-host_name') { - $self->{_vars}{sender_host_name} = $arg; - } elsif ($tag eq '-helo_name') { - $self->{_vars}{sender_helo_name} = $arg; - } elsif ($tag eq '-ident') { - $self->{_vars}{sender_ident} = $arg; - } elsif ($tag eq '-received_protocol') { - $self->{_vars}{received_protocol} = $arg; - } elsif ($tag eq '-N') { - $self->{_vars}{dont_deliver} = 1; + TAGGED: while () { + chomp; + my ($tag, $arg) = /^-?(-\S+)(?:\s+(.*))?$/ or last TAGGED; + + if ($tag eq '-acl') { + my $t; + return(0) if ($arg !~ /^(\d+)\s(\d+)$/); + if ($1 < $Exim::SpoolFile::ACL_C_MAX_LEGACY) { + $t = "acl_c$1"; } else { - # unrecognized tag, save it for reference - $self->{$tag} = $arg; + $t = "acl_m" . ($1 - $Exim::SpoolFile::ACL_C_MAX_LEGACY); } + read(I, $self->{_vars}{$t}, $2+1) || return(0); + chomp($self->{_vars}{$t}); + } elsif ($tag eq '-aclc') { + #return(0) if ($arg !~ /^(\d+)\s(\d+)$/); + return(0) if ($arg !~ /^(\S+)\s(\d+)$/); + my $t = "acl_c$1"; + read(I, $self->{_vars}{$t}, $2+1) || return(0); + chomp($self->{_vars}{$t}); + } elsif ($tag eq '-aclm') { + #return(0) if ($arg !~ /^(\d+)\s(\d+)$/); + return(0) if ($arg !~ /^(\S+)\s(\d+)$/); + my $t = "acl_m$1"; + read(I, $self->{_vars}{$t}, $2+1) || return(0); + chomp($self->{_vars}{$t}); + } elsif ($tag eq '-local') { + $self->{_vars}{sender_local} = 1; + } elsif ($tag eq '-localerror') { + $self->{_vars}{local_error_message} = 1; + } elsif ($tag eq '-local_scan') { + $self->{_vars}{local_scan_data} = $arg; + } elsif ($tag eq '-spam_score_int') { + $self->{_vars}{spam_score_int} = $arg; + $self->{_vars}{spam_score} = $arg / 10; + } elsif ($tag eq '-bmi_verdicts') { + $self->{_vars}{bmi_verdicts} = $arg; + } elsif ($tag eq '-host_lookup_deferred') { + $self->{_vars}{host_lookup_deferred} = 1; + } elsif ($tag eq '-host_lookup_failed') { + $self->{_vars}{host_lookup_failed} = 1; + } elsif ($tag eq '-body_linecount') { + $self->{_vars}{body_linecount} = $arg; + } elsif ($tag eq '-max_received_linelength') { + $self->{_vars}{max_received_linelength} = $arg; + } elsif ($tag eq '-body_zerocount') { + $self->{_vars}{body_zerocount} = $arg; + } elsif ($tag eq '-frozen') { + $self->{_vars}{deliver_freeze} = 1; + $self->{_vars}{deliver_frozen_at} = $arg; + } elsif ($tag eq '-allow_unqualified_recipient') { + $self->{_vars}{allow_unqualified_recipient} = 1; + } elsif ($tag eq '-allow_unqualified_sender') { + $self->{_vars}{allow_unqualified_sender} = 1; + } elsif ($tag eq '-deliver_firsttime') { + $self->{_vars}{deliver_firsttime} = 1; + $self->{_vars}{first_delivery} = 1; + } elsif ($tag eq '-manual_thaw') { + $self->{_vars}{deliver_manual_thaw} = 1; + $self->{_vars}{manually_thawed} = 1; + } elsif ($tag eq '-auth_id') { + $self->{_vars}{authenticated_id} = $arg; + } elsif ($tag eq '-auth_sender') { + $self->{_vars}{authenticated_sender} = $arg; + } elsif ($tag eq '-sender_set_untrusted') { + $self->{_vars}{sender_set_untrusted} = 1; + } elsif ($tag eq '-tls_certificate_verified') { + $self->{_vars}{tls_certificate_verified} = 1; + } elsif ($tag eq '-tls_cipher') { + $self->{_vars}{tls_cipher} = $arg; + } elsif ($tag eq '-tls_peerdn') { + $self->{_vars}{tls_peerdn} = $arg; + } elsif ($tag eq '-tls_sni') { + $self->{_vars}{tls_sni} = $arg; + } elsif ($tag eq '-host_address') { + $self->{_vars}{sender_host_port} = $self->_get_host_and_port(\$arg); + $self->{_vars}{sender_host_address} = $arg; + } elsif ($tag eq '-interface_address') { + $self->{_vars}{received_port} = + $self->{_vars}{interface_port} = $self->_get_host_and_port(\$arg); + $self->{_vars}{received_ip_address} = + $self->{_vars}{interface_address} = $arg; + } elsif ($tag eq '-active_hostname') { + $self->{_vars}{smtp_active_hostname} = $arg; + } elsif ($tag eq '-host_auth') { + $self->{_vars}{sender_host_authenticated} = $arg; + } elsif ($tag eq '-host_name') { + $self->{_vars}{sender_host_name} = $arg; + } elsif ($tag eq '-helo_name') { + $self->{_vars}{sender_helo_name} = $arg; + } elsif ($tag eq '-ident') { + $self->{_vars}{sender_ident} = $arg; + } elsif ($tag eq '-received_protocol') { + $self->{_vars}{received_protocol} = $arg; + } elsif ($tag eq '-N') { + $self->{_vars}{dont_deliver} = 1; } else { - last; + # unrecognized tag, save it for reference + $self->{$tag} = $arg; } } @@ -1266,34 +1264,16 @@ sub dump { } # BEGIN -sub ext_usage { - if ($ARGV[0] =~ /^--help$/i) { - require Config; - $ENV{PATH} .= ":" unless $ENV{PATH} eq ""; - $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}"; - #exec("perldoc", "-F", "-U", $0) || exit 1; - $< = $> = 1 if ($> == 0 || $< == 0); - exec("perldoc", $0) || exit 1; - # make parser happy - %Config::Config = (); - } elsif ($ARGV[0] =~ /^--version$/i) { - print "$p_name version $p_version\n\n$p_cp\n"; - } else { - return; - } - - exit(0); -} - __END__ =head1 NAME -exipick - selectively display messages from an Exim queue + exipick - selectively display messages from an Exim queue =head1 SYNOPSIS -exipick [] [ [ ...]] + exipick [] [ [ ...]] + exipick --help|--man =head1 DESCRIPTION