Perl 脚本从邮件头解析发件人的原始 IP

Question

我正在查看 perl 脚本（从邮件标头解析发件人的原始 IP），但我不知道该怎么做...

在使用 Google 进行查看后，我发现我必须使用一些 Perl 模块，例如：Mail::Field、Mail::Header、Email::Simple 等。

不幸的是，大多数示例都集中在发件人、收件人或/和主题上。更少关于发件人的原始 IP。

欢迎任何帮助！谢谢！

Answer 1

不确定这是您想要的：

假设：你有一个heade txt文件 从同一行中的 ipaddress 接收

运行：sender_ip.pl header.txt

[gliang@www perl_tools]$ cat sender_ip.pl

#!/usr/bin/perl
use strict;
use warnings;

return 1  unless $0 eq __FILE__;
main(@ARGV) if $0 eq __FILE__;

sub main{
    my @parameters = @_;

    my $file = check_input(@parameters);
    my @headerlines = read_header($file);
    my @ips  = get_ips(@headerlines);

    if(scalar(@ips)>0){
        print "\n*** sender ips @ips\n";
    }else{
        print "\n\n*** did not find sender ip\n";
    }
}

sub check_input{
    my @parameters  = @_;

    if(scalar(@parameters)>0){

    }else{
        print "\n*** add header.txt file, please!\n";
        exit(1);
    }
    my $file = $parameters[0];
    if(-e $file){

    }else{
        print "\n*** input file does not exist\n\n";
        exit(1);
    }
    return $file;
}

sub read_header{
    my $file  = $_[0];
    open(my $FILE, '<', $file);
    my @headerlines = <$FILE>;
    close($FILE);
    return @headerlines;
}


sub get_ips{
    my @headerlines= @_;

    my @ips;
    foreach my $line(@headerlines){
        chomp($line);
        if($line =~ m/Received/ && $line=~ m/from/i){
            if ($line =~ /(\d+\.\d+\.\d+\.\d+)/){
                my $ip = $1;
                push(@ips, $ip);
            }
        }
    }
    return @ips;
}