mailsize

   1 #! /usr/bin/perl
   2 # https://datatracker.ietf.org/doc/html/rfc1870
   3 use strict;
   4 use warnings;
   5 require Net::DNS;
   6 require Net::SMTP;
   7 use HTML::Entities;
   8 require URI::Query;
   9 use POSIX;
  10 $|=1;
  11
  12 die "arg required" if @ARGV!=!$ENV{"GATEWAY_INTERFACE"};
  13 my $arg=$ARGV[0];
  14
  15 my $nl="\n";
  16 my $html;
  17 if ($ENV{"GATEWAY_INTERFACE"}) {
  18   $nl="<br />$nl";
  19   $html=1;
  20   print <<"EOH";
  21 Content-type: text/html
  22
  23 <html><head><title>Maximum Mail Size Query</title></head><body>
  24 EOH
  25   my %q=URI::Query->new($ENV{"QUERY_STRING"})->hash();
  26   my $domain=$q{"domain"};
  27   if ($domain) {
  28     if ($domain=~/([^-_a-zA-Z0-9.])/) {
  29       print "<p><b>Error: Invalid character '".encode_entities($1)."' in specified domain name: ".encode_entities($domain)."</b></p>\n";
  30     } else {
  31       $arg=$domain;
  32     }
  33   }
  34 }
  35 sub query($) {
  36   my($domain)=@_;
  37   my $dns=Net::DNS::Resolver->new();
  38   #my $dns=Net::DNS::Resolver->new("nameservers"=>["255.255.255.255"]);
  39   my $reply=$dns->search($domain,"MX");
  40   my $type="MX";
  41   do { $type="AAAA"; $reply=$dns->search($domain,"AAAA") } if !$reply&&$dns->errorstring() eq "NOERROR";
  42   do { $type="A"   ; $reply=$dns->search($domain,"A"   ) } if !$reply&&$dns->errorstring() eq "NOERROR";
  43   if (!$reply) {
  44     print $dns->errorstring().$nl if !$reply;
  45     return;
  46   }
  47   print "Found $type$nl";
  48   my @retval;
  49   foreach my $rr ($reply->answer()) {
  50     my $addr;
  51     $addr=$rr->exchange() if $rr->type eq "MX";
  52     $addr=$rr->address() if $rr->type=~/^(?:A|AAAA)$/;
  53     do { print "Invalid RR: ".$rr->string()."$nl"; next; } if !defined $addr;
  54     print "$addr...$nl";
  55     my $smtp=Net::SMTP->new($addr,"Timeout"=>10);
  56     do { print "Cannot connect to SMTP server $addr: $@$nl"; next; } if !$smtp;
  57     my $size=($smtp->message()=~/^SIZE\s*(\d+)\s*$/mi)[0];
  58     push @retval,[$addr,$size];
  59   }
  60   return @retval;
  61 }
  62 sub load_ok() {
  63   local *F;
  64   open F,"/proc/loadavg" or die;
  65   my $load=defined <F> or die;
  66   close F or die;
  67   $load=~s/ .*//;
  68   return 1 if $load<16;
  69   print "<p>Sorry but the current machine load ($load) does not permit running this service now. Try again later.</p>\n";
  70   return 0;
  71 }
  72 if ($arg&&load_ok()) {
  73   print "<pre>\n";
  74   my @r=query $arg;
  75   print "</pre>\n";
  76   if (!@r) {
  77     print "<p>Error: Unable to determine anything about domain ".encode_entities($arg)."</p>\n";
  78   } else {
  79     my $size=$r[0][1];
  80     my $different;
  81     for my $r (@r) {
  82       $different=1 if ($size//-1)!=($r->[1]//-1);
  83     }
  84     sub sizecalc($) {
  85       my($input_size)=@_;
  86       # https://stackoverflow.com/a/1533248/2995591
  87       my $code_size    = ceil(($input_size * 4) / 3);
  88       my $padding_size = ($input_size % 3) ? (3 - ($input_size % 3)) : 0;
  89       my $crlfs_size   = 2 + ceil(2 * ($code_size + $padding_size) / 72);
  90       my $total_size   = $code_size + $padding_size + $crlfs_size;
  91       return $total_size;
  92     }
  93     sub rev($) {
  94       my($size)=@_;
  95       return 0 if $size==0;
  96       my $l=0;
  97       my $r=$size;
  98       while ($l+1<$r) {
  99         my $m=int(($l+$r)/2);
 100         my $x=sizecalc($m);
 101         if ($x<$size) {
 102           $l=$m;
 103         } else {
 104           $r=$m;
 105         }
 106       }
 107       return $l;
 108     }
 109     sub human($) {
 110       my($b)=@_;
 111       my $kb=int($b/1000);
 112       return "$b bytes" if !$kb;
 113       my $mb=int($kb/1000);
 114       return "$kb KB" if !$mb;
 115       my $gb=int($mb/1000);
 116       return "$mb MB" if !$gb;
 117       return "$gb GB";
 118     }
 119     sub size($) {
 120       my($size)=@_;
 121       return "unknown" if !defined $size;
 122       return "unlimited" if $size==0;
 123       my $rev=rev($size);
 124       return human($rev)." ($rev bytes; raw text mail size $size)";
 125     }
 126     if (!$different) {
 127       print "<p>Domain ".encode_entities($arg)." has maximum attachment size ".size($size)."</p>\n";
 128     } else {
 129       print "<p>Domain ".encode_entities($arg)." maximum attachment size depends on which server is contacted:</p>";
 130       print "<table border=\"1\">\n";
 131       for my $r (@r) {
 132         print "<tr><td>".encode_entities($r->[0])."</td><td>".size($r->[1])."</td></tr>\n";
 133       }
 134       print "</table>\n";
 135     }
 136   }
 137 }
 138 if ($ENV{"GATEWAY_INTERFACE"}) {
 139   print <<"EOH";
 140 <p>
 141   <form action="mailsize.cgi" method="get">
 142     <input type="text" name="domain" size="32" value="@{[ encode_entities($arg||"") ]}" autofocus="autofocus" />
 143     <input type="submit">
 144   </form>
 145 </p>
 146 <hr />
 147 <a href="https://git.jankratochvil.net/?p=mailsize.git;a=tree">GIT</a>
 148 </body></html>
 149 EOH
 150 }