% vim: syntax=prolog

library(crypto).
%use(library(cplfd)).
:- use_module(library(clpfd)).

% ip4(A,B,C,D) :- 
%   A in 0..255,
%   B in 0..255,
%   C in 0..255,
%   D in 0..255.

ip4(A, B, C, D, Addr) :- 
  A in 0..255,
  B in 0..255,
  C in 0..255,
  D in 0..255,
  Addr #= (A * 2^24 + B * 2^16 + C * 2^8 + D).

/*
?- ip4(1,2,3,D,Addr).
D in 0..255,
16909056+D#=Addr,
Addr in 16909056..16909311.
*/

ip4_s(Addr, Str) :-
  ip4(A, B, C, D, Addr),
  format(string(Str), "~w.~w.~w.~w", [A, B, C, D]).

ip4r(Addr, Range) :- 
  Max is 2^32-1,
  Addr in 0..Max,
  Range in 0..32.

ip4r_s(ip4r(Addr, Range), Str) :- 
  ip4_s(Addr, AddrStr),
  format(string(Str), "~w/~w", [AddrStr, Range]).

ip4r_o(A, B, C, D, Range, R) :-
  ip4(A, B, C, D, Addr),
  R = ip4r(Addr, Range).

net(a, ip4r(A, 24)) :- ip4(1,0,0,0, A).
net(b, ip4r(A, 24)) :- ip4(2,0,0,0, A).

% List all nets: net(Name, Net).

as_hex(Addr, Str) :-
  ip4(A, B, C, D, Addr),
  format(string(Str), "~16r.~16r.~16r.~16r", [A, B, C, D]).

show_nets :- 
  forall(net(Name, Range), (
        ip4r_s(Range, Str), format("~w: ~w~n", [Name, Str])
  )).

host_a_1(V) :- ip4(1,0,0,1,V).
host_a_2(V) :- ip4(1,0,0,2,V).
host_b_1(V) :- ip4(2,0,0,1,V).
host_b_2(V) :- ip4(2,0,0,2,V).

hosts(V) :- host_a_1(V).
hosts(V) :- host_a_2(V).
hosts(V) :- host_b_1(V).
hosts(V) :- host_b_2(V).

ip4_in_range(Addr, ip4r(Net, Range)) :- 
  HostMask is 2^(32 - Range)-1,
  NetMask is ((2^32-1) << (32 - Range)) /\ (2^32)-1,
  X is Addr /\ HostMask,
  Y is Addr /\ Net,
  format("~t~s~20| ~`0t~2r~33+-~n", ["addr", Addr]),
  format("~t~s~20| ~`0t~2r~33+-~n", ["host mask", HostMask]),
  format("~t~s~20| ~`0t~2r~33+-~n", ["net mask", NetMask]),
  format("~t~s~20| ~`0t~2r~33+-~n", ["net", Net]),
  format("~t~s~20| ~`0t~2r~33+-~n", ["x", X]),
  format("~t~s~20| ~`0t~2r~33+-~n", ["y", Y]),
  format("~w ~w~n", [Net, Range]),
  true.