1:-module(dhcp,
    2         [dhcp_wpad/1,
    3          dhcp_wpad/3,
    4          dhcp_inform/4]).    5
    6:-use_module(pac4pl, [enumerate_network_interfaces/1]).

DHCP interface

DHCP requires us to bind to port 68. This may require elevated privileges on some platforms

Currently only the DHCPINFORM message is implemented, and even then only a very few of the options necessary to get WPAD information. This can be easily extended by adding new clauses to dhcp_option//1 and optionally to translate_dhcp_option/3

author
- Matt Lilley (matt.lilley@securitease.com) */
   22%   0                   1                   2                   3
   23%   0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
   24%   +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
   25%   |     op (1)    |   htype (1)   |   hlen (1)    |   hops (1)    |
   26%   +---------------+---------------+---------------+---------------+
   27%   |                            xid (4)                            |
   28%   +-------------------------------+-------------------------------+
   29%   |           secs (2)            |           flags (2)           |
   30%   +-------------------------------+-------------------------------+
   31%   |                          ciaddr  (4)                          |
   32%   +---------------------------------------------------------------+
   33%   |                          yiaddr  (4)                          |
   34%   +---------------------------------------------------------------+
   35%   |                          siaddr  (4)                          |
   36%   +---------------------------------------------------------------+
   37%   |                          giaddr  (4)                          |
   38%   +---------------------------------------------------------------+
   39%   |                                                               |
   40%   |                          chaddr  (16)                         |
   41%   |                                                               |
   42%   |                                                               |
   43%   +---------------------------------------------------------------+
   44%   |                                                               |
   45%   |                          sname   (64)                         |
   46%   +---------------------------------------------------------------+
   47%   |                                                               |
   48%   |                          file    (128)                        |
   49%   +---------------------------------------------------------------+
   50%   |                                                               |
   51%   |                          options (variable)                   |
   52%   +---------------------------------------------------------------+
   53
   54dhcp_wpad(Reply):-
   55        enumerate_network_interfaces(Interfaces),
   56        member(interface(Id, ip, IPAddress), Interfaces),
   57        memberchk(interface(Id, dl, HWAddress), Interfaces),
   58        dhcp_wpad(HWAddress, IPAddress, Reply),
   59        !. % Cut member/2 BTP
   60
   61dhcp_wpad(HWAddress, IPAddress, WPAD):-
   62        dhcp_inform(HWAddress, IPAddress, [inform, wpad, message_length(2048)], Reply),
   63        memberchk(wpad=WPAD, Reply).
   64
   65dhcp_inform(HWAddress, IPAddress, Options, Reply):-
   66        dhcp_inform_packet(HWAddress, IPAddress, [cookie|Options], Bytes, []),
   67        atom_codes(Packet, Bytes),
   68        debug(dhcp, 'Trying ~w (~w)...~n', [HWAddress, IPAddress]),
   69        setup_call_cleanup(udp_socket(Socket),
   70                           do_exchange(Socket, Packet, ReplyCodes),
   71                           tcp_close_socket(Socket)),
   72        debug(dhcp, 'Got response!~n', []),
   73        parse_dhcp_packet(Reply, ReplyCodes, []).
   74
   75do_exchange(Socket, Packet, ReplyCodes):-
   76        tcp_setopt(Socket, broadcast),
   77        catch(tcp_bind(Socket, 68),
   78              Error,
   79              ( tcp_close_socket(Socket),
   80                throw(Error)
   81              )),
   82        udp_send(Socket, Packet, ip(255,255,255,255):67, []),
   83        catch(call_with_time_limit(3, udp_receive(Socket, ReplyCodes, _From, [as(codes), max_message_size(2048)])),
   84              Error,            % Probably a timeout
   85              ( advise([debug(dhcp)], warning, 'DHCP failed with ~p', [Error]),
   86                fail
   87              )).
   88
   89parse_dhcp_packet(Reply)-->
   90        {length(DHCPHeader, 236)},
   91        DHCPHeader,
   92        dhcp_option(cookie),
   93        parse_dhcp_packet_1(Reply).
   94
   95parse_dhcp_packet_1([], [], []):- !. % Actual end of message
   96parse_dhcp_packet_1([])--> [255], !, parse_dhcp_packet_1(_). % End of message marker. Everything after this is ignored
   97parse_dhcp_packet_1(Options)--> [0], !, parse_dhcp_packet_1(Options). % Padding after EOM
   98parse_dhcp_packet_1([Option|Options])-->
   99        [Code],
  100        [Length],        
  101        parse_dhcp_option(Code, Length, Option),
  102        parse_dhcp_packet_1(Options).
  103
  104parse_dhcp_option(Code, Length, Option)-->
  105        {length(Codes, Length)},
  106        Codes,
  107        {(translate_dhcp_option(Code, Codes, Option)->
  108            true
  109         ; otherwise->
  110            Option = (Code=Codes)
  111         )}.
  112
  113
  114dhcp_message_type(5, ack).
  115
  116translate_dhcp_option(53, [A], message_type=Key):-
  117        ( dhcp_message_type(A, Key)->
  118            true
  119        ; otherwise->
  120            Key = unknown(A)
  121        ).
  122translate_dhcp_option(252, Codes, wpad=Atom):- atom_codes(Atom, Codes), !.
  123translate_dhcp_option(54, [A,B,C,D], server_identifier=ip(A,B,C,D)):- !.
  124translate_dhcp_option(1, [A,B,C,D], subnet_mask=ip(A,B,C,D)):- !.
  125translate_dhcp_option(3, [A,B,C,D], router=ip(A,B,C,D)):- !.
  126translate_dhcp_option(6, [A,B,C,D], dns_server=ip(A,B,C,D)):- !.
  127
  128dhcp_inform_packet(HWAddress, IPAddress, Options)-->
  129        dhcp_operation(boot_request),
  130        dhcp_htype(ethernet),
  131        dhcp_hlen(6),
  132        dhcp_hops(0),
  133        dhcp_xid(_),
  134        dhcp_secs(0),
  135        dhcp_flags(0),
  136        dhcp_addr(IPAddress),       % CI
  137        dhcp_addr(ip(0, 0, 0, 0)),  % YI
  138        dhcp_addr(ip(0, 0, 0, 0)),  % SI
  139        dhcp_addr(ip(0, 0, 0, 0)),  % GI
  140        dhcp_hwaddr(HWAddress),     % CH
  141        dhcp_sname(''),
  142        dhcp_file(''),
  143        dhcp_options(Options).
  144
  145dhcp_options([]) --> !, dhcp_eom.
  146dhcp_options([Option|Options]) -->
  147        dhcp_option(Option),
  148        dhcp_options(Options).
  149
  150dhcp_option(cookie) --> [99, 130, 83, 99].
  151dhcp_option(inform) --> [53, 1, 8].
  152dhcp_option(wpad) --> [252, 0].
  153dhcp_option(message_length(L))--> [57, 2], uint16(L).
  154
  155dhcp_eom --> [255].
  156
  157dhcp_operation(boot_request)--> [1].
  158dhcp_operation(boot_reply)--> [2].
  159
  160dhcp_htype(ethernet)--> [1].
  161
  162dhcp_hlen(Length)--> [Length].
  163dhcp_hops(Hops)--> [Hops].
  164
  165dhcp_xid(Xid)--> {Xid is random(2^32)}, uint32(Xid).
  166
  167dhcp_secs(S) --> uint16(S).
  168dhcp_flags(S) --> uint16(S).
  169
  170dhcp_addr(ip(A,B,C,D))--> [A, B, C, D].
  171dhcp_hwaddr(mac(A,B,C,D,E,F))--> [A,B,C,D,E,F,0,0,0,0,0,0,0,0,0,0].
  172dhcp_sname(Atom)-->
  173        {atom_length(Atom, L),
  174         ( L > 64 -> throw(type_error(dhcp_sname, Atom)) ; true),
  175           format(atom(Padded), '~`0t~w~64+', [Atom]),
  176           atom_codes(Padded, Codes)},
  177        Codes.
  178
  179dhcp_file(Atom)-->
  180        {atom_length(Atom, L),
  181         ( L > 128 -> throw(type_error(dhcp_filename, Atom)) ; true),
  182           format(atom(Padded), '~`0t~w~128+', [Atom]),
  183           atom_codes(Padded, Codes)},
  184        Codes.
  185
  186uint32(X)-->
  187        {A is (X >> 24) /\ 255,
  188         B is (X >> 16) /\ 255,
  189         C is (X >> 8) /\ 255,
  190         D is X /\ 255},
  191        [A, B, C, D].
  192
  193uint16(X)-->
  194        {C is (X >> 8) /\ 255,
  195         D is X /\ 255},
  196        [C, D]