| 1 | #!/usr/bin/perl -w |
|---|
| 2 | # Web page reporting the requester's IP address. |
|---|
| 3 | # Copyright (c) 2014 by James F. Carter |
|---|
| 4 | |
|---|
| 5 | # To the URL append a query string of "?debug" to get debug info. |
|---|
| 6 | |
|---|
| 7 | use CGI; |
|---|
| 8 | use DateTime; |
|---|
| 9 | use Net::DNS; |
|---|
| 10 | use Socket qw(inet_pton AF_INET AF_INET6); |
|---|
| 11 | |
|---|
| 12 | our $opt_D = ($ENV{QUERY_STRING} // '') eq 'debug'; |
|---|
| 13 | |
|---|
| 14 | # Print the HTML header, HTTP head area, and page title. |
|---|
| 15 | print <<EOH; |
|---|
| 16 | Content-type: text/html |
|---|
| 17 | |
|---|
| 18 | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" |
|---|
| 19 | "http://www.w3.org/TR/html4/loose.dtd"> |
|---|
| 20 | <!-- Template validated: http://validator.w3.org/ --> |
|---|
| 21 | <html><head><title>What Is My IP Address |
|---|
| 22 | </title> |
|---|
| 23 | <meta http-equiv="Content-Type" content="text/html; charset=utf-8"> |
|---|
| 24 | <meta name="author" content="James F. Carter"> |
|---|
| 25 | <meta name="copyright" content="(c) 2014 by James F. Carter"> |
|---|
| 26 | <meta name="viewport" content="width=device-width"> |
|---|
| 27 | <!-- Various methods to discourage a browser from redisplaying the same content |
|---|
| 28 | on successive visits. --> |
|---|
| 29 | <META http-equiv="Expires" content="Fri, 2 Jan 1970 00:00:01 -0000"> |
|---|
| 30 | <META http-equiv="cachecontrol" content="no-store"> |
|---|
| 31 | <META http-equiv="Cache-Control" content="no-store"> |
|---|
| 32 | <META http-equiv="Cache-Control" content="no-cache"> |
|---|
| 33 | <META http-equiv="Pragma" content="no-cache"> |
|---|
| 34 | </head><body> |
|---|
| 35 | <div style="float:right; margin-left:-100%"><!-- of window, far to the right of the right margin --> |
|---|
| 36 | <a href="http://validator.w3.org/check?uri=referer"><img |
|---|
| 37 | src="/~jimc/icons/valid-html401.png" |
|---|
| 38 | alt="Valid HTML 4.01 Transitional"></a> |
|---|
| 39 | </div> |
|---|
| 40 | <h1 align=center>What Is My IP Address |
|---|
| 41 | </h1> |
|---|
| 42 | |
|---|
| 43 | <p> This program reports the IP address from which a web request came. |
|---|
| 44 | If the requester is using Network Address Translation (NAT), the translated |
|---|
| 45 | or wild-side address will be reported. |
|---|
| 46 | |
|---|
| 47 | <p><table width="100%"><col width="20%"><col width="80%"> |
|---|
| 48 | EOH |
|---|
| 49 | |
|---|
| 50 | chomp(my $HOSTNAME = $ENV{HOSTNAME} // qx(uname -n)); |
|---|
| 51 | my $peer = CGI::remote_addr(); |
|---|
| 52 | |
|---|
| 53 | # For a HTTPS connection from Surya, (try to) retrieve the real client. |
|---|
| 54 | # (CGI has remote_addr() but not remote_port()) |
|---|
| 55 | my ($proxy, $proxyhn); # Filled in with proxy IP and name if detected. |
|---|
| 56 | PROXY: { |
|---|
| 57 | my $srvp = ($ENV{SERVER_PORT} // '0'); |
|---|
| 58 | print "<tr><td>DEBUG <td>Server port = $srvp peer = $peer\n" if $opt_D; |
|---|
| 59 | my %proxyadr = qw( 192.9.200.185 1 2600:3c01:e000:306::8:1 1 |
|---|
| 60 | 192.9.200.193 1 2600:3c01:e000:306::c1 1 ); |
|---|
| 61 | last unless $srvp eq '443' && $proxyadr{$peer}; |
|---|
| 62 | my $remp = ($ENV{REMOTE_PORT} // '0'); |
|---|
| 63 | $rema6 = (index($peer, ':') >= 0) ? "[$peer]" : $peer; |
|---|
| 64 | my $url = "http://$rema6:80/proxysrc.cgi?$peer:$remp"; |
|---|
| 65 | $url .= ';debug' if $opt_D; |
|---|
| 66 | my $realpeer = qx(curl $url 2> /dev/null); |
|---|
| 67 | printf "<tr><td>DEBUG <td>rmport = %d url = '%s' realpeer = '%s'\n", $remp, $url, ($realpeer // '(undef)') if $opt_D; |
|---|
| 68 | last if !defined($realpeer) || $realpeer eq ''; |
|---|
| 69 | $realpeer =~ s/:\d+$//; # Remove port (last colon separated unit) |
|---|
| 70 | $realpeer =~ s/^.*\]//; # Remove [address family] leaving IP |
|---|
| 71 | $proxy = $peer; |
|---|
| 72 | $peer = $realpeer; |
|---|
| 73 | } |
|---|
| 74 | |
|---|
| 75 | my $svrq = CGI::server_name(); # This is the host the client requested |
|---|
| 76 | my $selfip = $ENV{SERVER_ADDR} // ''; |
|---|
| 77 | my($fam, $famint) = (index($peer,':') >= 0) ? ('IPv6', AF_INET6) : |
|---|
| 78 | ('IPv4', AF_INET); |
|---|
| 79 | my $selfhn; # Hostname corresp. to the requested server IP |
|---|
| 80 | if ($selfip ne '') { |
|---|
| 81 | my $famint = (index($selfip,':') >= 0) ? AF_INET6 : AF_INET; |
|---|
| 82 | $selfhn = gethostbyaddr(inet_pton($famint, $selfip), $famint) // 'name unknown'; |
|---|
| 83 | } else { |
|---|
| 84 | $selfip = 'IP not available'; |
|---|
| 85 | $selfhn = $HOSTNAME; |
|---|
| 86 | } |
|---|
| 87 | $selfhn = "req. $svrq, actual $selfhn" if $svrq ne $selfhn; |
|---|
| 88 | |
|---|
| 89 | |
|---|
| 90 | |
|---|
| 91 | my $dns = Net::DNS::Resolver->new(); |
|---|
| 92 | my ($peerhn) = rr($dns, $peer); |
|---|
| 93 | $peerhn = ($peerhn && $peerhn->can('ptrdname')) ? $peerhn->ptrdname() |
|---|
| 94 | : 'name unknown'; |
|---|
| 95 | my $peeraf = (index($peer,':') >= 0) ? 'IPv6' : 'IPv4'; |
|---|
| 96 | |
|---|
| 97 | if (defined($proxy)) { |
|---|
| 98 | ($proxyhn) = rr($dns, $proxy); |
|---|
| 99 | $proxyhn = ($proxyhn && $proxyhn->can('ptrdname')) ? $proxyhn->ptrdname() |
|---|
| 100 | : 'name unknown'; |
|---|
| 101 | } |
|---|
| 102 | |
|---|
| 103 | my $dt = DateTime->now()->set_time_zone('local'); |
|---|
| 104 | my $now = $dt->format_cldr('yyyy-MM-dd HH:mm:ss ZZZZ'); |
|---|
| 105 | my $utc = $dt->set_time_zone('UTC')->format_cldr('yyyy-MM-dd HH:mm:ss zzz'); |
|---|
| 106 | |
|---|
| 107 | printf "<tr><td>Address Family <td id=family>%s\n", $fam; |
|---|
| 108 | print "<tr><td>Your IP Address <td id=ipaddr>$peer ($peerhn)\n"; |
|---|
| 109 | print "<tr><td>Proxy From <td id=proxyaddr>$proxy ($proxyhn)\n" |
|---|
| 110 | if defined($proxy); |
|---|
| 111 | print "<tr><td>Server's IP Address <td id=server>$selfip ($selfhn)\n"; |
|---|
| 112 | print "<tr><td>Time on Server <td id=date>$now = $utc\n"; |
|---|
| 113 | |
|---|
| 114 | print <<EOF; |
|---|
| 115 | </table> |
|---|
| 116 | |
|---|
| 117 | <p> An outside site with a more extensive test of your IPv6 connectivity: <ul> |
|---|
| 118 | <li><a href="http://test-ipv6.com/"> test-ipv6.com </a> |
|---|
| 119 | <li><a href="http://ipv6.test-ipv6.com/"> ipv6.test-ipv6.com </a> |
|---|
| 120 | (Only for clients incapable of IPv4) |
|---|
| 121 | </ul> |
|---|
| 122 | |
|---|
| 123 | </body></html> |
|---|
| 124 | EOF |
|---|
| 125 | |
|---|
