Patch title: Release 91 bulk changes
Abstract:
File: /linux/network/net.pli
Key:
    Removed line
    Added line
abstract
  [This module will give you the ability to deal with Linux net features (configuring devices and routing).]


# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/os.pli"
module "/pliant/language/os/socket.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/execute.pli"
module "/pliant/linux/kernel/module.pli"

constant debug false


#------------------------------------------------------------------------

doc
  ['net_configure' will configure a Linux network interface (alternative to using 'ifconfig' Unix command).]
  para
    [Sample usage:]
    listing
      net_configure "eth0" "10.1.1.2/255.255.255.0"
  ['net_shutdown' will bring the interface down.]
  para
    [Sample usage:]
    listing
      net_shutdown "eth0"


type os_ifreq
  field (Array Char 16) name
  field os_sockaddr_in addr

type os_ifreq2
  field (Array Char 16) name
  field uInt flags

constant os_SIOCSIFADDR 8916h
constant os_SIOCSIFNETMASK 891Ch
constant os_SIOCGIFFLAGS 8913h
constant os_SIOCSIFFLAGS 8914h
constant os_SIOCGIFTXQLEN 8942h
constant os_SIOCSIFTXQLEN 8943h
constant os_IFF_UP 01h
constant os_IFF_RUNNING 40h


function net_configure device def options -> status
  arg Str device def options ; arg Status status
  var Int socket := os_socket os_AF_INET os_SOCK_DGRAM 0
  if socket<=0
    return failure
  status := success
  var os_ifreq req
  var Str devicez := device+"[0]"
  memory_copy devicez:characters (addressof req:name) devicez:len
  if def=""
    void
  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))
    req:addr sin_family := os_AF_INET
    req:addr sin_port := 0
    req:addr sin_addr := (cast i1 uInt)*256^3 + (cast i2 uInt)*256^2 + (cast i3 uInt)*256 + (cast i4 uInt)
    if (os_ioctl socket os_SIOCSIFADDR addressof:req)<0
      if debug
        console "failed to set address for net interface "+device eol
      status := failure
    req:addr sin_addr := (cast m1 uInt)*256^3 + (cast m2 uInt)*256^2 + (cast m3 uInt)*256 + (cast m4 uInt)
    if (os_ioctl socket os_SIOCSIFNETMASK addressof:req)<0
      if debug
        console "failed to set mask for net interface "+device eol
      status := failure
  else
    error error_id_unexpected "invalid interface definition "+def
    return failure
  if (os_ioctl socket os_SIOCGIFFLAGS addressof:req)<0
    if debug
      console "failed to get flags for net interface "+device eol
    status := failure
  var Int qlen := options option "queue_length" Int
  if qlen=defined
    (addressof:req map os_ifreq2) flags := qlen
    os_ioctl socket os_SIOCSIFTXQLEN addressof:req
  (addressof:req map os_ifreq2) flags := (addressof:req map os_ifreq2):flags .or. os_IFF_UP .or. os_IFF_RUNNING
  if (os_ioctl socket os_SIOCSIFFLAGS addressof:req)<0
    if debug
      console "failed to get up net interface "+device eol
    status := failure
  os_close socket

function net_configure device def -> status
  arg Str device def ; arg Status status
  status := net_configure device def ""

function net_shutdown device -> status
  arg Str device ; arg Status status
  var Int socket := os_socket os_AF_INET os_SOCK_DGRAM 0
  if socket<=0
    return failure
  var os_ifreq req
  var Str devicez := device+"[0]"
  memory_copy devicez:characters (addressof req:name) devicez:len
  status := success
  if (os_ioctl socket os_SIOCGIFFLAGS addressof:req)<0
    if debug
      console "failed to get flags for net interface "+device eol
    status := failure
  (addressof:req map os_ifreq2) flags := (addressof:req map os_ifreq2):flags .and. .not. os_IFF_UP
  if (os_ioctl socket os_SIOCSIFFLAGS addressof:req)<0
    if debug
      console "failed to shut down net interface "+device eol
    status := failure
  os_close socket


#------------------------------------------------------------------------

doc
  ['net_route' will add a routing entry in the kernel.]
  para
    [Sample usage:]
    listing
      net_route "0.0.0.0/0.0.0.0" "10.1.1.1"
  [Please notice that routing to [dq][dq] will request the kernel to drop the packets.]
  para
    [Sample usage:]
    listing
      net_route "10.0.0.0/255.0.0.0" ""
  ['net_discard' will remove the routing entry.]
  para
    [Sample usage:]
    listing
      net_discard "0.0.0.0/0.0.0.0" "10.1.1.1"


type os_rtentry
  packed
  field uInt rt_pad1
  field os_sockaddr_in rt_dst
  field os_sockaddr_in rt_gateway
  field os_sockaddr_in rt_genmask
  field uInt16 rt_flags
  field Int16 rt_pad2
  field uInt rt_pad3
  field Address rt_pad4
  field Int16 rt_metric
  field uInt16 rt_pad5
  field Address rt_dev
  field uInt rt_mtu
  field uInt et_window
  field uInt16 rt_irtt
  field uInt16 rt_pad6

constant os_RTF_UP       0001h
constant os_RTF_GATEWAY  0002h
constant os_RTF_HOST     0004h
constant os_RTF_REJECT   0200h
constant os_SIOCADDRT    890Bh
constant os_SIOCDELRT    890Ch

function route def to fun -> status
  arg Str def to ; arg Int fun ; arg Status status
  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))
    error error_id_unexpected "invalid routing definition "+def
    return failure
  var Str device := ""
  if not (to eparse (var Int t1) "." (var Int t2) "." (var Int t3) "." (var Int t4))
    device := to+"[0]"
  memory_clear addressof:(var os_rtentry rt) os_rtentry:size
  rt rt_flags := os_RTF_UP
  rt:rt_dst sin_family := os_AF_INET
  rt:rt_dst sin_addr := (cast i1 uInt)*256^3 + (cast i2 uInt)*256^2 + (cast i3 uInt)*256 + (cast i4 uInt)
  rt:rt_genmask sin_family := os_AF_INET
  rt:rt_genmask sin_addr := (cast m1 uInt)*256^3 + (cast m2 uInt)*256^2 + (cast m3 uInt)*256 + (cast m4 uInt)
  if device=""
    rt:rt_gateway sin_family := os_AF_INET
    rt:rt_gateway sin_addr := (cast t1 uInt)*256^3 + (cast t2 uInt)*256^2 + (cast t3 uInt)*256 + (cast t4 uInt)
    rt rt_flags := rt:rt_flags .or. os_RTF_GATEWAY
  eif device="[0]"
    rt rt_dev := "lo[0]" characters
    rt rt_flags := rt:rt_flags .or. os_RTF_REJECT
  else
    rt rt_dev := device characters
  var Int socket := os_socket os_AF_INET os_SOCK_DGRAM 0
  if socket<=0
    return failure
  status := shunt (os_ioctl socket fun addressof:rt)>=0 success failure
  os_close socket

function net_route def to -> status
  arg Str def to ; arg Status status
  status := route def to os_SIOCADDRT
  if debug and status=failure
    console "failed to set route to "+def eol

function net_discard def to -> status
  arg Str def to ; arg Status status
  status := route def to os_SIOCDELRT
  if debug and status=failure
    console "failed to remove route to "+def eol


function tcp_setting name value
  arg Str name value
  (var Stream proc) open "file:/proc/sys/net/ipv4/"+name out+safe
  proc writeline value
  proc close

function net_rule_2_2 cmd
  arg Str cmd
  if (constant (file_query "file:/bin/iptables" standard)=undefined)
    # console "    ipchains " cmd eol
    execute "ipchains "+cmd
  
function net_rule_2_4 cmd
  arg Str cmd
  if (constant (file_query "file:/bin/iptables" standard)=defined)
    # console "    iptables " cmd eol
    execute "iptables "+cmd
  
function net_rule cmd
  arg Str cmd
  if (constant (file_query "file:/bin/iptables" standard)=defined)
    # console "    iptables " cmd eol
    execute "iptables "+cmd
  else
    # console "    ipchains " cmd eol
    execute "ipchains "+(replace cmd "DROP" "REJECT")
    
function net_optimize options
  arg Str options
  # standard protocol does not work great on the Internet
  tcp_setting "tcp_timestamps" "0"
  # standard protocol does not work great on the Internet, but let's keep it
  if (options option "tcp_timestamps" Bool true)=false
    tcp_setting "tcp_timestamps" "0"
  # dead connections will be closed within 15 minutes
  tcp_setting "tcp_keepalive_time" "180"
  tcp_setting "tcp_keepalive_probes" "5"
  if (options option "forward")
    tcp_setting "ip_forward" "1"
    tcp_setting "ip_always_defrag" "1"
  net_rule "-F"
  net_rule_2_4 "-t nat -F"


function net_filter action device inside outside
  arg Str action device inside outside
  # possible actions: internet nat filter
  if (constant (file_query "file:/bin/iptables" standard)=defined)
    execute "insmod ip_tables" quiet
    execute "insmod iptable_filter" quiet
    # execute "insmod ipt_REJECT" quiet
    kernel_load_module "ip_tables"
    kernel_load_module "iptable_filter"
    # kernel_load_module "ipt_REJECT"
  if action="nat"
    if (constant (file_query "file:/bin/iptables" standard)=defined)
      execute "insmod ip_conntrack" quiet
      execute "insmod iptable_nat" quiet
      execute "insmod ipt_MASQUERADE" quiet
      kernel_load_module "ip_conntrack"
      kernel_load_module "iptable_nat"
      kernel_load_module "ipt_MASQUERADE"
    net_rule_2_2 "-A forward -i "+device+" -j MASQ"
    net_rule_2_4 "-t nat -A POSTROUTING -o "+device+" -j MASQUERADE"
  if action="internet" or action="nat" or (action="filter" and outside<>"")
    net_rule "-N "+device+"in"
    net_rule_2_2 "-A input -i "+device+" -j "+device+"in"
    net_rule_2_4 "-A INPUT -i "+device+" -j "+device+"in"
    net_rule_2_4 "-A FORWARD -i "+device+" -j "+device+"in"
    if action="internet" or action="nat"
      net_rule "-A "+device+"in -p udp --destination-port 111 -j DROP" # RPC (NFS)
      net_rule "-A "+device+"in -p tcp --destination-port 111 -j DROP" # RPC (NFS)
      net_rule "-A "+device+"in -p udp --destination-port 139 -j DROP" # Samba
      net_rule "-A "+device+"in -p tcp --destination-port 139 -j DROP" # Samba
      # net_rule "-A "+device+"in -p tcp --destination-port 515 -j DROP" # LPD
      net_rule "-A "+device+"in -p udp --destination-port 548 -j DROP" # Netatalk
      net_rule "-A "+device+"in -p tcp --destination-port 548 -j DROP" # Netatalk
      net_rule "-A "+device+"in -p tcp --destination-port 6000 -j DROP" # X11
    var Str all := outside
    while all<>""
      if not (all parse any:(var Str first) _ any:(var Str remain))
        first := all ; remain := ""
      if (first parse "-" any:(var Str exclude))
        net_rule "-A "+device+"in --destination "+exclude+" -j DROP"
      else
        net_rule "-A "+device+"in --destination "+first+" -j ACCEPT"
      all := remain
    if action="internet" or action="nat"
      # no access from the Internet to the internal network
      # usefull for security if ISP is broken
      # ... but broken if using NAT
      void # net_rule "-A "+device+"in -d 10.0.0.0/255.0.0.0 -j DROP"
    net_rule_2_2 "-A "+device+"in -j "+(shunt action="internet" or action="nat" "ACCEPT" "REJECT")
    if action="filter"
      net_rule_2_4 "-A "+device+"in -j DROP"
  if action="internet" or action="nat" or (action="filter" and inside<>"")
    net_rule "-N "+device+"out"
    net_rule_2_2 "-A output -i "+device+" -j "+device+"out"
    net_rule_2_4 "-A OUTPUT -o "+device+" -j "+device+"out"
    net_rule_2_4 "-A FORWARD -o "+device+" -j "+device+"out"
    var Str all := inside
    while all<>""
      if not (all parse any:(var Str first) _ any:(var Str remain))
        first := all ; remain := ""
      if (first parse "-" any:(var Str exclude))
        net_rule "-A "+device+"out --destination "+exclude+" -j DROP"
      else
        net_rule "-A "+device+"out --destination "+first+" -j ACCEPT"
      all := remain
    if action="internet" or action="nat"
      # don't route any internal network traffic to the Internet
      # usefull because the (ISDN) Linux routing table are not stable
      net_rule "-A "+device+"out -d 10.0.0.0/255.0.0.0 -j DROP"
    net_rule_2_2 "-A "+device+"out -j "+(shunt action="internet" or action="nat" "ACCEPT" "REJECT")
    if action="filter"
      net_rule_2_4 "-A "+device+"out -j DROP"

export net_configure net_shutdown net_route net_discard net_optimize net_filter