#! /usr/bin/perl # https://datatracker.ietf.org/doc/html/rfc1870 use strict; use warnings; require Net::DNS; require Net::SMTP; use HTML::Entities; require URI::Query; use POSIX; $|=1; die "arg required" if @ARGV!=!$ENV{"GATEWAY_INTERFACE"}; my $arg=$ARGV[0]; my $nl="\n"; my $html; if ($ENV{"GATEWAY_INTERFACE"}) { $nl="
$nl"; $html=1; print <<"EOH"; Content-type: text/html Maximum Mail Size Query EOH my %q=URI::Query->new($ENV{"QUERY_STRING"})->hash(); my $domain=$q{"domain"}; if ($domain) { if ($domain=~/([^-_a-zA-Z0-9.])/) { print "

Error: Invalid character '".encode_entities($1)."' in specified domain name: ".encode_entities($domain)."

\n"; } else { $arg=$domain; } } } sub query($) { my($domain)=@_; my $dns=Net::DNS::Resolver->new(); #my $dns=Net::DNS::Resolver->new("nameservers"=>["255.255.255.255"]); my $reply=$dns->search($domain,"MX"); my $type="MX"; do { $type="AAAA"; $reply=$dns->search($domain,"AAAA") } if !$reply&&$dns->errorstring() eq "NOERROR"; do { $type="A" ; $reply=$dns->search($domain,"A" ) } if !$reply&&$dns->errorstring() eq "NOERROR"; if (!$reply) { print $dns->errorstring().$nl if !$reply; return; } print "Found $type$nl"; my @retval; foreach my $rr ($reply->answer()) { my $addr; $addr=$rr->exchange() if $rr->type eq "MX"; $addr=$rr->address() if $rr->type=~/^(?:A|AAAA)$/; do { print "Invalid RR: ".$rr->string()."$nl"; next; } if !defined $addr; print "$addr...$nl"; my $smtp=Net::SMTP->new($addr,"Timeout"=>10); do { print "Cannot connect to SMTP server $addr: $@$nl"; next; } if !$smtp; my $size=($smtp->message()=~/^SIZE\s*(\d+)\s*$/mi)[0]; push @retval,[$addr,$size]; } return @retval; } sub load_ok() { local *F; open F,"/proc/loadavg" or die; my $load=defined or die; close F or die; $load=~s/ .*//; return 1 if $load<16; print "

Sorry but the current machine load ($load) does not permit running this service now. Try again later.

\n"; return 0; } if ($arg&&load_ok()) { print "
\n";
  my @r=query $arg;
  print "
\n"; if (!@r) { print "

Error: Unable to determine anything about domain ".encode_entities($arg)."

\n"; } else { my $size=$r[0][1]; my $different; for my $r (@r) { $different=1 if ($size//-1)!=($r->[1]//-1); } sub sizecalc($) { my($input_size)=@_; # https://stackoverflow.com/a/1533248/2995591 my $code_size = ceil(($input_size * 4) / 3); my $padding_size = ($input_size % 3) ? (3 - ($input_size % 3)) : 0; my $crlfs_size = 2 + ceil(2 * ($code_size + $padding_size) / 72); my $total_size = $code_size + $padding_size + $crlfs_size; return $total_size; } sub rev($) { my($size)=@_; return 0 if $size==0; my $l=0; my $r=$size; while ($l+1<$r) { my $m=int(($l+$r)/2); my $x=sizecalc($m); if ($x<$size) { $l=$m; } else { $r=$m; } } return $l; } sub human($) { my($b)=@_; my $kb=int($b/1000); return "$b bytes" if !$kb; my $mb=int($kb/1000); return "$kb KB" if !$mb; my $gb=int($mb/1000); return "$mb MB" if !$gb; return "$gb GB"; } sub size($) { my($size)=@_; return "unknown" if !defined $size; return "unlimited" if $size==0; my $rev=rev($size); return human($rev)." ($rev bytes; raw text mail size $size)"; } if (!$different) { print "

Domain ".encode_entities($arg)." has maximum attachment size ".size($size)."

\n"; } else { print "

Domain ".encode_entities($arg)." maximum attachment size depends on which server is contacted:

"; print "\n"; for my $r (@r) { print "\n"; } print "
".encode_entities($r->[0])."".size($r->[1])."
\n"; } } } if ($ENV{"GATEWAY_INTERFACE"}) { print <<"EOH";

GIT EOH }