Implemented /ula6 route and template; new layout for iframes

This commit is contained in:
swagg boi 2021-03-05 16:01:18 -05:00
parent 83cc7b74e7
commit b646f11378
4 changed files with 88 additions and 4 deletions

View file

@ -59,7 +59,7 @@
give it one. Maybe some wayward network nerd standing up an IPv6 lab
will find this useful :)
</p>
<iframe src="/ula6.html" width="720" style="border:none;"></iframe>
<iframe src="/ula6" width="720" style="border:none;"></iframe>
<p>
<i>Limit of 1,208,925,819,614,629,174,706,176 ULA addresses per
customer.</i>

View file

@ -0,0 +1,11 @@
<!DOCTYPE HTML>
<html lang="en">
<head>
<meta charset="UTF-8">
<title><%= title %></title>
<link rel="stylesheet" type="text/css" href="/css/swagg.css">
</head>
<body>
<%= content %>
</body>
</html>

12
templates/ula6.html.ep Normal file
View file

@ -0,0 +1,12 @@
% title 'Swagg::Net ULA Tool';
% layout 'swagg-iframe';
<% if ($ula6) { %>
<form>Your IPv6 ULA prefix is <%= $ula6 %>.</form>
<% } else { %>
<form action="/ula6" method="get">
MAC address:<br>
<input type="text" name="macaddr"><br>
<br>
<input type="submit" value="Submit">
</form>
<% } %>

View file

@ -1,18 +1,79 @@
#!/usr/bin/env perl
use Mojolicious::Lite;
# Daniel Bowling <swaggboi@slackware.uk>
# Mar 2021
use Mojolicious::Lite;
use Regexp::Common qw{net};
use Digest::SHA qw{sha1_hex};
# The main landing page; pass in the output of the fortune command
get '/' => sub {
my ($c) = @_;
my $fortune = `fortune` || "huh??\n";
my $fortune = `fortune` || "huh?? no fortune for u\n";
$c->render(fortune => $fortune)
$c->render(fortune => $fortune);
} => 'index';
# Deprecation of IE page
get '/die';
get '/me';
get '/news';
# Process mac address to ula6 ala the ol' ula6.cgi script:
# - Current time of day in 64-bit NTP format
# - Obtain EUI64
# - Cat first with second
# - Compute SHA-1 of third and use least significant 40 bits
# TODO: This ancient code could certainly be cleaned up
get '/ula6' => sub {
my ($c) = @_;
my $mac = lc $c->param('macaddr'); # Lower-case plz
my $ula6;
# Check the MAC
if ($mac =~ /$RE{net}{MAC}/) {
# Local vars for this bit
my (
$binfield,
$decfield,
$digesty,
$epoch,
@fields,
$fulleui,
$halfone,
$halftwo,
$hexfield,
$uniqueid
);
# EUI64
@fields = split(/:/, $mac);
$halfone = $fields[0] . $fields[1] . $fields[2] . "ff";
$halftwo = "fe" . $fields[3] . $fields[4] . $fields[5];
$binfield = sprintf "%b", hex $fields[0];
$decfield = sprintf "%d", hex $fields[0];
$decfield = ($binfield =~ m/1[01]$/) ? $decfield - 2 : $decfield + 2;
$binfield = sprintf "%b", int $decfield;
$hexfield = sprintf "%x", int $decfield;
$halfone = $hexfield . $fields[1] . $fields[2] . "ff";
$fulleui = $halfone . $halftwo;
# Current time of day
$epoch = time() + 2208988800;
# Cat with the time
$digesty = sha1_hex($epoch . $fulleui);
($uniqueid = "fd" . substr $digesty, -10) =~ s/(.{1,4})/$1:/gs;
# Set the ULA
$ula6 = $uniqueid . ':/48';
}
$c->render(ula6 => $ula6);
};
# Send it
app->start();