/pliant/linux/network/net.pli
 
 1  abstract 
 2    [This module will give you the ability to deal with Linux net features (configuring devices and routing).] 
 3   
 4   
 5  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 6  # 
 7  # This program is free software; you can redistribute it and/or 
 8  # modify it under the terms of the GNU General Public License version 2 
 9  # as published by the Free Software Foundation. 
 10  # 
 11  # This program is distributed in the hope that it will be useful, 
 12  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 13  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 14  # GNU General Public License for more details. 
 15  # 
 16  # You should have received a copy of the GNU General Public License 
 17  # version 2 along with this program; if not, write to the Free Software 
 18  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 19   
 20  module "/pliant/language/os.pli" 
 21  module "/pliant/language/os/socket.pli" 
 22  module "/pliant/language/stream.pli" 
 23  module "/pliant/admin/file.pli" 
 24  module "/pliant/admin/execute.pli" 
 25  module "/pliant/linux/kernel/module.pli" 
 26   
 27  constant debug false 
 28  constant iptables (file_query "file:/bin/iptables" standard)=success 
 29  constant iptables64 (file_query "file:/amd64/bin/iptables" standard)=success 
 30   
 31   
 32 
 
 33   
 34  doc 
 35    ['net_configure' will configure a Linux network interface (alternative to using 'ifconfig' Unix command).] 
 36    para 
 37      [Sample usage:] 
 38      listing 
 39        net_configure "eth0" "10.1.1.2/255.255.255.0" 
 40    ['net_shutdown' will bring the interface down.] 
 41    para 
 42      [Sample usage:] 
 43      listing 
 44        net_shutdown "eth0" 
 45   
 46   
 47  type os_ifreq 
 48    field (Array Char 16) name 
 49    field os_sockaddr_in addr 
 50   
 51  type os_ifreq2 
 52    field (Array Char 16) name 
 53    field uInt flags 
 54   
 55  constant os_SIOCSIFADDR 8916h 
 56  constant os_SIOCSIFNETMASK 891Ch 
 57  constant os_SIOCGIFFLAGS 8913h 
 58  constant os_SIOCSIFFLAGS 8914h 
 59  constant os_SIOCGIFTXQLEN 8942h 
 60  constant os_SIOCSIFTXQLEN 8943h 
 61  constant os_IFF_UP 01h 
 62  constant os_IFF_RUNNING 40h 
 63   
 64   
 65  function net_configure device def options -> status 
 66    arg Str device def options ; arg Status status 
 67    var Int socket := os_socket os_AF_INET os_SOCK_DGRAM 0 
 68    if socket<=0 
 69      return failure 
 70    status := success 
 71    var os_ifreq req 
 72    var Str devicez := device+"[0]" 
 73    memory_copy devicez:characters (addressof req:name) devicez:len 
 74    if def="" 
 75      void 
 76    eif (def eparse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) "/" (var Int m1) "." (var Int m2) "." (var Int m3) "." (var Int m4)) 
 77      req:addr sin_family := os_AF_INET 
 78      req:addr sin_port := 0 
 79      req:addr sin_addr := (cast i1 uInt)*256^+ (cast i2 uInt)*256^+ (cast i3 uInt)*256 + (cast i4 uInt) 
 80      if (os_ioctl socket os_SIOCSIFADDR addressof:req)<0 
 81        if debug 
 82          console "failed to set address for net interface "+device eol 
 83        status := failure 
 84      req:addr sin_addr := (cast m1 uInt)*256^+ (cast m2 uInt)*256^+ (cast m3 uInt)*256 + (cast m4 uInt) 
 85      if (os_ioctl socket os_SIOCSIFNETMASK addressof:req)<0 
 86        if debug 
 87          console "failed to set mask for net interface "+device eol 
 88        status := failure 
 89    else 
 90      error error_id_unexpected "invalid interface definition "+def 
 91      return failure 
 92    if (os_ioctl socket os_SIOCGIFFLAGS addressof:req)<0 
 93      if debug 
 94        console "failed to get flags for net interface "+device eol 
 95      status := failure 
 96    var Int qlen := options option "queue_length" Int 
 97    if qlen=defined 
 98      (addressof:req map os_ifreq2) flags := qlen 
 99      os_ioctl socket os_SIOCSIFTXQLEN addressof:req 
 100    (addressof:req map os_ifreq2) flags := (addressof:req map os_ifreq2):flags .or. os_IFF_UP .or. os_IFF_RUNNING 
 101    if (os_ioctl socket os_SIOCSIFFLAGS addressof:req)<0 
 102      if debug 
 103        console "failed to get up net interface "+device eol 
 104      status := failure 
 105    os_close socket 
 106   
 107  function net_configure device def -> status 
 108    arg Str device def ; arg Status status 
 109    status := net_configure device def "" 
 110   
 111  function net_shutdown device -> status 
 112    arg Str device ; arg Status status 
 113    var Int socket := os_socket os_AF_INET os_SOCK_DGRAM 0 
 114    if socket<=0 
 115      return failure 
 116    var os_ifreq req 
 117    var Str devicez := device+"[0]" 
 118    memory_copy devicez:characters (addressof req:name) devicez:len 
 119    status := success 
 120    if (os_ioctl socket os_SIOCGIFFLAGS addressof:req)<0 
 121      if debug 
 122        console "failed to get flags for net interface "+device eol 
 123      status := failure 
 124    (addressof:req map os_ifreq2) flags := (addressof:req map os_ifreq2):flags .and. .not. os_IFF_UP 
 125    if (os_ioctl socket os_SIOCSIFFLAGS addressof:req)<0 
 126      if debug 
 127        console "failed to shut down net interface "+device eol 
 128      status := failure 
 129    os_close socket 
 130   
 131   
 132 
 
 133   
 134  doc 
 135    ['net_route' will add a routing entry in the kernel.] 
 136    para 
 137      [Sample usage:] 
 138      listing 
 139        net_route "0.0.0.0/0.0.0.0" "10.1.1.1" 
 140    [Please notice that routing to [dq][dq] will request the kernel to drop the packets.] 
 141    para 
 142      [Sample usage:] 
 143      listing 
 144        net_route "10.0.0.0/255.0.0.0" "" 
 145    ['net_discard' will remove the routing entry.] 
 146    para 
 147      [Sample usage:] 
 148      listing 
 149        net_discard "0.0.0.0/0.0.0.0" "10.1.1.1" 
 150   
 151   
 152  type os_rtentry 
 153    packed 
 154    field uInt rt_pad1 
 155    field os_sockaddr_in rt_dst 
 156    field os_sockaddr_in rt_gateway 
 157    field os_sockaddr_in rt_genmask 
 158    field uInt16 rt_flags 
 159    field Int16 rt_pad2 
 160    field uInt rt_pad3 
 161    field Address rt_pad4 
 162    field Int16 rt_metric 
 163    field uInt16 rt_pad5 
 164    field Address rt_dev 
 165    field uInt rt_mtu 
 166    field uInt et_window 
 167    field uInt16 rt_irtt 
 168    field uInt16 rt_pad6 
 169   
 170  constant os_RTF_UP       0001h 
 171  constant os_RTF_GATEWAY  0002h 
 172  constant os_RTF_HOST     0004h 
 173  constant os_RTF_REJECT   0200h 
 174  constant os_SIOCADDRT    890Bh 
 175  constant os_SIOCDELRT    890Ch 
 176   
 177  function route def to fun -> status 
 178    arg Str def to ; arg uInt fun ; arg Status status 
 179    if not (def eparse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) "/" (var Int m1) "." (var Int m2) "." (var Int m3) "." (var Int m4)) 
 180      error error_id_unexpected "invalid routing definition "+def 
 181      return failure 
 182    var Str device := "" 
 183    if not (to eparse (var Int t1) "." (var Int t2) "." (var Int t3) "." (var Int t4)) 
 184      device := to+"[0]" 
 185    memory_clear addressof:(var os_rtentry rt) os_rtentry:size 
 186    rt rt_flags := os_RTF_UP 
 187    rt:rt_dst sin_family := os_AF_INET 
 188    rt:rt_dst sin_addr := (cast i1 uInt)*256^+ (cast i2 uInt)*256^+ (cast i3 uInt)*256 + (cast i4 uInt) 
 189    rt:rt_genmask sin_family := os_AF_INET 
 190    rt:rt_genmask sin_addr := (cast m1 uInt)*256^+ (cast m2 uInt)*256^+ (cast m3 uInt)*256 + (cast m4 uInt) 
 191    if device="" 
 192      rt:rt_gateway sin_family := os_AF_INET 
 193      rt:rt_gateway sin_addr := (cast t1 uInt)*256^+ (cast t2 uInt)*256^+ (cast t3 uInt)*256 + (cast t4 uInt) 
 194      rt rt_flags := rt:rt_flags .or. os_RTF_GATEWAY 
 195    eif device="[0]" 
 196      rt rt_dev := "lo[0]" characters 
 197      rt rt_flags := rt:rt_flags .or. os_RTF_REJECT 
 198    else 
 199      rt rt_dev := device characters 
 200    var Int socket := os_socket os_AF_INET os_SOCK_DGRAM 0 
 201    if socket<=0 
 202      return failure 
 203    status := shunt (os_ioctl socket fun addressof:rt)>=0 success failure 
 204    os_close socket 
 205   
 206  function net_route def to -> status 
 207    arg Str def to ; arg Status status 
 208    status := route def to os_SIOCADDRT 
 209    if debug and status=failure 
 210      console "failed to set route to "+def eol 
 211   
 212  function net_discard def to -> status 
 213    arg Str def to ; arg Status status 
 214    status := route def to os_SIOCDELRT 
 215    if debug and status=failure 
 216      console "failed to remove route to "+def eol 
 217   
 218   
 219  function tcp_setting name value 
 220    arg Str name value 
 221    (var Stream proc) open "file:/proc/sys/net/ipv4/"+name out+safe 
 222    proc writeline value 
 223    proc close 
 224   
 225  function net_rule_2_2 cmd 
 226    arg Str cmd 
 227    if not iptables and not iptables64 
 228      # console "    ipchains " cmd eol 
 229      execute "ipchains "+cmd 
 230     
 231  function net_rule_2_4 cmd 
 232    arg Str cmd 
 233    if iptables 
 234      # console "    iptables " cmd eol 
 235      execute "iptables "+cmd 
 236    eif iptables64 
 237      execute "iptables "+cmd root "file:/amd64/" 
 238     
 239  function net_rule cmd 
 240    arg Str cmd 
 241    if iptables 
 242      # console "    iptables " cmd eol 
 243      execute "iptables "+cmd 
 244    eif iptables64 
 245      execute "iptables "+cmd root "file:/amd64/" 
 246    else 
 247      # console "    ipchains " cmd eol 
 248      execute "ipchains "+(replace cmd "DROP" "REJECT") 
 249       
 250  function net_optimize options 
 251    arg Str options 
 252    # standard protocol does not work great on the Internet, but let's keep it 
 253    if (options option "tcp_timestamps" Bool true)=false 
 254      tcp_setting "tcp_timestamps" "0" 
 255    # dead connections will be closed within 15 minutes 
 256    tcp_setting "tcp_keepalive_time" "180" 
 257    tcp_setting "tcp_keepalive_probes" "5" 
 258    if (options option "forward") 
 259      tcp_setting "ip_forward" "1" 
 260      tcp_setting "ip_always_defrag" "1" 
 261    net_rule "-F" 
 262    net_rule_2_4 "-t nat -F" 
 263   
 264   
 265  function net_filter action device inside outside 
 266    arg Str action device inside outside 
 267    # possible actions: internet nat filter 
 268    if iptables or iptables64 
 269      kernel_load_module "ip_tables" 
 270      kernel_load_module "iptable_filter" 
 271      # kernel_load_module "ipt_REJECT" 
 272    if action="nat" 
 273      if iptables or iptables64 
 274        kernel_load_module "ip_conntrack" 
 275        kernel_load_module "iptable_nat" 
 276        kernel_load_module "ipt_MASQUERADE" 
 277      net_rule_2_2 "-A forward -i "+device+" -j MASQ" 
 278      net_rule_2_4 "-t nat -A POSTROUTING -o "+device+" -j MASQUERADE" 
 279    if action="internet" or action="nat" or (action="filter" and outside<>"") 
 280      net_rule "-N "+device+"in" 
 281      net_rule_2_2 "-A input -i "+device+" -j "+device+"in" 
 282      net_rule_2_4 "-A INPUT -i "+device+" -j "+device+"in" 
 283      net_rule_2_4 "-A FORWARD -i "+device+" -j "+device+"in" 
 284      if action="internet" or action="nat" 
 285        net_rule "-A "+device+"in -p udp --destination-port 111 -j DROP" # RPC (NFS) 
 286        net_rule "-A "+device+"in -p tcp --destination-port 111 -j DROP" # RPC (NFS) 
 287        net_rule "-A "+device+"in -p udp --destination-port 112 -j DROP" # rpc.mountd under FullPliant 
 288        net_rule "-A "+device+"in -p tcp --destination-port 112 -j DROP" # rpc.mountd under FullPliant 
 289        net_rule "-A "+device+"in -p udp --destination-port 139 -j DROP" # Samba 
 290        net_rule "-A "+device+"in -p tcp --destination-port 139 -j DROP" # Samba 
 291        net_rule "-A "+device+"in -p udp --destination-port 445 -j DROP" # Samba extra 
 292        net_rule "-A "+device+"in -p tcp --destination-port 445 -j DROP" # Samba extra 
 293        # net_rule "-A "+device+"in -p tcp --destination-port 515 -j DROP" # LPD 
 294        net_rule "-A "+device+"in -p udp --destination-port 548 -j DROP" # Netatalk 
 295        net_rule "-A "+device+"in -p tcp --destination-port 548 -j DROP" # Netatalk 
 296        net_rule "-A "+device+"in -p tcp --destination-port 6000 -j DROP" # X11 
 297      var Str all := outside 
 298      while all<>"" 
 299        if not (all parse any:(var Str first) _ any:(var Str remain)) 
 300          first := all ; remain := "" 
 301        if (first parse "-" any:(var Str exclude)) 
 302          net_rule "-A "+device+"in --destination "+exclude+" -j DROP" 
 303        else 
 304          net_rule "-A "+device+"in --destination "+first+" -j ACCEPT" 
 305        all := remain 
 306      if action="internet" or action="nat" 
 307        # no access from the Internet to the internal network 
 308        # usefull for security if ISP is broken 
 309        # ... but broken if using NAT 
 310        void # net_rule "-A "+device+"in -d 10.0.0.0/255.0.0.0 -j DROP" 
 311      net_rule_2_2 "-A "+device+"in -j "+(shunt action="internet" or action="nat" "ACCEPT" "REJECT") 
 312      if action="filter" 
 313        net_rule_2_4 "-A "+device+"in -j DROP" 
 314    if action="internet" or action="nat" or (action="filter" and inside<>"") 
 315      net_rule "-N "+device+"out" 
 316      net_rule_2_2 "-A output -i "+device+" -j "+device+"out" 
 317      net_rule_2_4 "-A OUTPUT -o "+device+" -j "+device+"out" 
 318      net_rule_2_4 "-A FORWARD -o "+device+" -j "+device+"out" 
 319      var Str all := inside 
 320      while all<>"" 
 321        if not (all parse any:(var Str first) _ any:(var Str remain)) 
 322          first := all ; remain := "" 
 323        if (first parse "-" any:(var Str exclude)) 
 324          net_rule "-A "+device+"out --destination "+exclude+" -j DROP" 
 325        else 
 326          net_rule "-A "+device+"out --destination "+first+" -j ACCEPT" 
 327        all := remain 
 328      if action="internet" or action="nat" 
 329        # don't route any internal network traffic to the Internet 
 330        # usefull because the (ISDN) Linux routing table are not stable 
 331        net_rule "-A "+device+"out -d 10.0.0.0/255.0.0.0 -j DROP" 
 332      net_rule_2_2 "-A "+device+"out -j "+(shunt action="internet" or action="nat" "ACCEPT" "REJECT") 
 333      if action="filter" 
 334        net_rule_2_4 "-A "+device+"out -j DROP" 
 335   
 336  export net_configure net_shutdown net_route net_discard net_optimize net_filter 
 337