├── Changelog ├── debian ├── copyright ├── source │ └── format ├── arpsponge.init ├── docs ├── arpsponge.links ├── rules └── control ├── tools ├── mkdist ├── mkinstalldirs ├── rminstalldirs └── bsdinst ├── lib ├── Makefile └── M6 │ ├── Makefile │ └── ArpSponge │ ├── Control │ ├── Makefile │ ├── Base.pm │ └── Client.pm │ ├── Makefile │ ├── Table.pm │ ├── Control.pm │ ├── Const.pm │ ├── Event.pm │ ├── Log.pm │ ├── Base.pm │ ├── Queue.pm │ ├── NetPacket.pm │ ├── Util.pm │ └── Sponge.pm ├── sbin ├── Makefile └── aslogtail.pl ├── .gitignore ├── Copying ├── t ├── dosponge2 ├── dosponge ├── testpcap └── testqueue.pl ├── doc ├── Makefile ├── arpsponge_architecture.txt └── command_mapping.txt ├── man └── Makefile ├── init.d ├── Makefile └── arpsponge.sh ├── MANIFEST ├── Makefile ├── defaults.sample.src ├── README.md ├── TODO ├── config.mk └── rules.mk /Changelog: -------------------------------------------------------------------------------- 1 | debian/changelog -------------------------------------------------------------------------------- /debian/copyright: -------------------------------------------------------------------------------- 1 | ../Copying -------------------------------------------------------------------------------- /debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (native) 2 | -------------------------------------------------------------------------------- /debian/arpsponge.init: -------------------------------------------------------------------------------- 1 | ../init.d/arpsponge -------------------------------------------------------------------------------- /debian/docs: -------------------------------------------------------------------------------- 1 | TODO 2 | README.md 3 | defaults.sample 4 | doc/command_mapping.txt 5 | doc/arpsponge_architecture.txt 6 | -------------------------------------------------------------------------------- /debian/arpsponge.links: -------------------------------------------------------------------------------- 1 | /usr/sbin/arpsponge /usr/local/sbin/arpsponge 2 | /usr/sbin/asctl /usr/local/sbin/asctl 3 | /usr/sbin/aslogtail /usr/local/sbin/aslogtail 4 | -------------------------------------------------------------------------------- /tools/mkdist: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -n 2 | # 3 | SWITCH:{ 4 | /^\#NODIST/ && do{ 5 | $nodist = 1; 6 | last SWITCH}; 7 | ($nodist && /^\#END-NODIST/) && do{ 8 | $nodist = 0; 9 | last SWITCH}; 10 | !$nodist && do{ 11 | print; 12 | last SWITCH}; 13 | } 14 | -------------------------------------------------------------------------------- /debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | MAKE_ARGUMENTS := \ 4 | LIBROOT='$$(DIRPREFIX)/share/perl5' \ 5 | DIRPREFIX='$$(DESTDIR)/usr' \ 6 | MANDIR='$$(DOCPREFIX)/man' \ 7 | SPONGE_VAR='/run/$$(NAME)' 8 | 9 | %: 10 | dh $@ 11 | 12 | override_dh_auto_build: 13 | $(MAKE) $(MAKE_ARGUMENTS) 14 | 15 | override_dh_auto_install: 16 | $(MAKE) install SKIPDOCS=1 DESTDIR=$(CURDIR)/debian/arpsponge $(MAKE_ARGUMENTS) 17 | 18 | -------------------------------------------------------------------------------- /lib/Makefile: -------------------------------------------------------------------------------- 1 | #!make 2 | # 3 | # Copyright 2005-2016 AMS-IX B.V. 4 | # 5 | # This is free software. It can be distributed under 6 | # your choice of the GPL or Artistic License 2.0. 7 | # 8 | # See the Copying file that came with this package. 9 | 10 | TOPDIR = .. 11 | 12 | include $(TOPDIR)/config.mk 13 | include $(TOPDIR)/rules.mk 14 | 15 | default : all 16 | 17 | all : M6-all 18 | 19 | install : M6-install 20 | 21 | clean : M6-clean 22 | 23 | veryclean : M6-veryclean 24 | -------------------------------------------------------------------------------- /lib/M6/Makefile: -------------------------------------------------------------------------------- 1 | #!make 2 | # 3 | # Copyright 2005-2016 AMS-IX B.V. 4 | # 5 | # This is free software. It can be distributed under 6 | # your choice of the GPL or Artistic License 2.0. 7 | # 8 | # See the Copying file that came with this package. 9 | 10 | TOPDIR = ../.. 11 | 12 | include $(TOPDIR)/config.mk 13 | 14 | include $(TOPDIR)/rules.mk 15 | 16 | all : ArpSponge-all 17 | 18 | install : ArpSponge-install 19 | 20 | clean : ArpSponge-clean 21 | 22 | veryclean : ArpSponge-veryclean 23 | 24 | # E.O.F. Makefile 25 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Control/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright 2005-2016 AMS-IX B.V. 2 | # 3 | # This is free software. It can be distributed under 4 | # your choice of the GPL or Artistic License 2.0. 5 | # 6 | # See the Copying file that came with this package. 7 | # 8 | TOPDIR = ../../../.. 9 | 10 | include $(TOPDIR)/config.mk 11 | 12 | 13 | INSTALLDIR = $(INSTLIB)/M6/ArpSponge/Control 14 | 15 | INSTALLFILES = \ 16 | $(INSTALLDIR)/Base.pm \ 17 | $(INSTALLDIR)/Client.pm \ 18 | $(INSTALLDIR)/Server.pm 19 | 20 | include $(TOPDIR)/rules.mk 21 | 22 | # E.O.F. Makefile 23 | -------------------------------------------------------------------------------- /sbin/Makefile: -------------------------------------------------------------------------------- 1 | #!make 2 | # 3 | # Copyright 2005-2016 AMS-IX B.V. 4 | # 5 | # This is free software. It can be distributed under 6 | # your choice of the GPL or Artistic License 2.0. 7 | # 8 | # See the Copying file that came with this package. 9 | # 10 | include ../config.mk 11 | 12 | TOPDIR = .. 13 | 14 | INSTALLDIRS = $(BINDIR) 15 | 16 | TARGETS = \ 17 | arpsponge \ 18 | aslogtail \ 19 | asctl 20 | 21 | INSTALLFILES = \ 22 | $(BINDIR)/arpsponge \ 23 | $(BINDIR)/aslogtail \ 24 | $(BINDIR)/asctl 25 | 26 | include ../rules.mk 27 | 28 | # E.O.F. Makefile 29 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | arpsponge.man 2 | arpsponge.ps 3 | arpsponge-*.tar.gz 4 | build-stamp 5 | configure-stamp 6 | debian/.debhelper/ 7 | debian/debhelper-build-stamp 8 | debian/arpsponge/ 9 | debian/*.*.log 10 | debian/*.substvars 11 | debian/*.*.debhelper 12 | debian/files 13 | defaults.sample 14 | init.d/arpsponge 15 | installed.log 16 | man/arpsponge.8 17 | man/arpsponge.pod 18 | man/asctl.8 19 | man/asctl.pod 20 | man/aslogtail.8 21 | man/aslogtail.pod 22 | sbin/arpsponge 23 | sbin/asctl 24 | sbin/aslogtail 25 | Build 26 | MYMETA.json 27 | MYMETA.yml 28 | _build/ 29 | blib/ 30 | cover_db/ 31 | -------------------------------------------------------------------------------- /Copying: -------------------------------------------------------------------------------- 1 | Copyright: (c) 2004-2011 AMS-IX B.V. 2 | 3 | This program is free software; it may may be redistributed under 4 | the terms of either the GNU General Public License or the Artistic 5 | License. 6 | 7 | On a Debian GNU/Linux systems, the complete text of these licenses 8 | may be found in the files /usr/share/common-licenses/{GPL,Artistic}. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 13 | 14 | Upstream Author(s): Steven Bakker 15 | 16 | License: 17 | 18 | GPL 19 | Artistic 20 | -------------------------------------------------------------------------------- /t/dosponge2: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # 3 | 4 | DIR=$(cd $(dirname $0)/..; pwd) 5 | PERL5LIB=$DIR/lib 6 | echo PERL5LIB=$PERL5LIB 7 | export PERL5LIB 8 | IFNAME=eth0 9 | 10 | [[ $DEBUG = 1 ]] && PERL="perl -d" 11 | $PERL $DIR/sbin/arpsponge \ 12 | --dummy \ 13 | --verbose \ 14 | --rundir=./rundir/$IFNAME \ 15 | --sponge-network \ 16 | --gratuitous \ 17 | --init=NONE \ 18 | --learning=5 \ 19 | --queuedepth=200 \ 20 | --rate=30 \ 21 | --pending=10 \ 22 | --sweep=900/3600 \ 23 | --age=600 \ 24 | --flood-protection=5 \ 25 | 91.200.17.0/26 dev $IFNAME 26 | 27 | #--daemon=/var/run/arpsponge/eth0/pid \ 28 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | #!make 2 | # 3 | # Copyright 2005-2016 AMS-IX B.V. 4 | # 5 | # This is free software. It can be distributed under 6 | # your choice of the GPL or Artistic License 2.0. 7 | # 8 | # See the Copying file that came with this package. 9 | # 10 | include ../config.mk 11 | 12 | TOPDIR = .. 13 | 14 | TARGETS = 15 | 16 | # debian/rules specifies make instlal SKIPDOCS=1 to 17 | # prevent us from installing docs. The debian/docs 18 | # file will take care of that. 19 | ifndef SKIPDOCS 20 | 21 | INSTALLDIRS = $(DOCDIR) 22 | 23 | INSTALLFILES = \ 24 | $(DOCDIR)/arpsponge_architecture.txt \ 25 | $(DOCDIR)/command_mapping.txt 26 | 27 | endif 28 | 29 | include ../rules.mk 30 | 31 | # E.O.F. Makefile 32 | -------------------------------------------------------------------------------- /t/dosponge: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | 4 | #IPADDR/PREFIXLEN dev IFNAME 5 | 6 | rm -f sponge.out sponge.status 7 | 8 | if [ ! -p sponge.notify ] 9 | then 10 | rm -f sponge.notify 11 | mkfifo sponge.notify 12 | fi 13 | 14 | touch sponge.out 15 | 16 | #../sbin/arpsponge 10.1.1.0/25 dev eth0:1 \ 17 | #arpsponge 193.194.136.128/25 dev eth0 \ 18 | 19 | ../sbin/arpsponge 193.194.136.128/25 dev eth0 \ 20 | \ 21 | --verbose=1 \ 22 | --notify=sponge.notify \ 23 | --status=sponge.status \ 24 | \ 25 | --init=NONE \ 26 | --sponge-network \ 27 | --learning=10 \ 28 | \ 29 | --queuedepth=20 \ 30 | --rate=50 \ 31 | --pending=5 \ 32 | \ 33 | --sweep=900/3600 \ 34 | --gratuitous \ 35 | --age=600 \ 36 | \ 37 | 2>&1 | es -a -r 3 -p 86400 -s sponge.out & 38 | 39 | #2>&1 | es -a -r 3 -p 86400 sponge.out 40 | # --dummy \ 41 | -------------------------------------------------------------------------------- /tools/mkinstalldirs: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # mkinstalldirs --- make directory hierarchy 3 | # Author: Noah Friedman 4 | # Created: 1993-05-16 5 | # LICENSE: Public domain 6 | 7 | errstatus=0 8 | 9 | for file 10 | do 11 | set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` 12 | shift 13 | 14 | pathcomp= 15 | for d 16 | do 17 | pathcomp="$pathcomp$d" 18 | case "$pathcomp" in 19 | -* ) pathcomp=./$pathcomp ;; 20 | esac 21 | 22 | if test ! -d "$pathcomp"; then 23 | echo "mkdir $pathcomp" 1>&2 24 | 25 | mkdir "$pathcomp" || lasterr=$? 26 | 27 | if test ! -d "$pathcomp"; then 28 | errstatus=$lasterr 29 | fi 30 | fi 31 | 32 | pathcomp="$pathcomp/" 33 | done 34 | done 35 | 36 | exit $errstatus 37 | 38 | # mkinstalldirs ends here 39 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright 2005-2016 AMS-IX B.V. 2 | # 3 | # This is free software. It can be distributed under 4 | # your choice of the GPL or Artistic License 2.0. 5 | # 6 | # See the Copying file that came with this package. 7 | # 8 | TOPDIR = ../../.. 9 | 10 | include $(TOPDIR)/config.mk 11 | 12 | 13 | INSTALLDIR = $(INSTLIB)/M6/ArpSponge 14 | 15 | INSTALLFILES = \ 16 | $(INSTALLDIR)/Base.pm \ 17 | $(INSTALLDIR)/Const.pm \ 18 | $(INSTALLDIR)/Control.pm \ 19 | $(INSTALLDIR)/Event.pm \ 20 | $(INSTALLDIR)/Log.pm \ 21 | $(INSTALLDIR)/NetPacket.pm \ 22 | $(INSTALLDIR)/Queue.pm \ 23 | $(INSTALLDIR)/ReadLine.pm \ 24 | $(INSTALLDIR)/Sponge.pm \ 25 | $(INSTALLDIR)/Table.pm \ 26 | $(INSTALLDIR)/Util.pm 27 | 28 | include $(TOPDIR)/rules.mk 29 | 30 | all : Control-all 31 | 32 | install : Control-install 33 | 34 | clean : Control-clean 35 | 36 | veryclean : Control-veryclean 37 | 38 | # E.O.F. Makefile 39 | -------------------------------------------------------------------------------- /man/Makefile: -------------------------------------------------------------------------------- 1 | #!make 2 | # 3 | # Copyright 2005-2016 AMS-IX B.V. 4 | # 5 | # This is free software. It can be distributed under 6 | # your choice of the GPL or Artistic License 2.0. 7 | # 8 | # See the Copying file that came with this package. 9 | # 10 | include ../config.mk 11 | 12 | TOPDIR = .. 13 | 14 | SECTION = 8 15 | 16 | TARGETS = \ 17 | $(NAME).pod \ 18 | $(NAME).$(SECTION) \ 19 | asctl.pod \ 20 | aslogtail.pod \ 21 | asctl.$(SECTION) \ 22 | aslogtail.$(SECTION) 23 | 24 | INSTALLFILES = \ 25 | $(MANDIR)/man$(SECTION)/$(NAME).$(SECTION) \ 26 | $(MANDIR)/man$(SECTION)/asctl.$(SECTION) \ 27 | $(MANDIR)/man$(SECTION)/aslogtail.$(SECTION) 28 | 29 | include ../rules.mk 30 | 31 | $(NAME).pod: ../sbin/$(NAME) 32 | $(RM) -f $@ 33 | ln -s $? $@ 34 | 35 | asctl.pod: ../sbin/asctl 36 | $(RM) -f $@ 37 | ln -s $? $@ 38 | 39 | aslogtail.pod: ../sbin/aslogtail 40 | $(RM) -f $@ 41 | ln -s $? $@ 42 | 43 | # cd $(TOPDIR); $(MAKE) $@ 44 | 45 | # E.O.F. Makefile 46 | -------------------------------------------------------------------------------- /doc/arpsponge_architecture.txt: -------------------------------------------------------------------------------- 1 | (Hopelessly outdated) 2 | 3 | WORKINGS 4 | -------- 5 | 6 | We keep three tables: 7 | 8 | STATE 9 | - Indexed by IP address 10 | - Contains state flag: 11 | -2 == DEAD 12 | -1 == ALIVE 13 | n>=0 == PENDING/n 14 | 15 | QUEUE 16 | - Indexed by IP address 17 | - Each IP maps to a circular buffer of QUEUE_DEPTH elements 18 | - Buffer holds timestamps and source IPs for ARP queries 19 | 20 | Startup: 21 | 22 | for each IP in RANGE: 23 | set STATE[IP] to PENDING/0; 24 | 25 | loop over incoming packets (src, dst, type): 26 | 27 | set STATE[src] to ALIVE; 28 | clear QUEUE[src]; 29 | 30 | if type == ARP: 31 | 32 | add timestamp to QUEUE[dst]; 33 | 34 | if STATE[dst] == ALIVE: 35 | if depth of QUEUE[dst] == MAX_QUEUE: 36 | if rate for dst >= MAX_RATE 37 | set STATE[dst] to PENDING/0; 38 | 39 | if STATE[dst] == PENDING/n: 40 | if n > MAX_PENDING: 41 | set STATE[dst] to DEAD; 42 | else 43 | increment STATE[dst]; 44 | send ARP_QUERY for dst; 45 | 46 | if STATE[dst] == DEAD: 47 | send ARP_REPLY for dst; 48 | 49 | -------------------------------------------------------------------------------- /init.d/Makefile: -------------------------------------------------------------------------------- 1 | #!make 2 | # 3 | # Copyright 2005-2016 AMS-IX B.V. 4 | # 5 | # This is free software. It can be distributed under 6 | # your choice of the GPL or Artistic License 2.0. 7 | # 8 | # See the Copying file that came with this package. 9 | # 10 | include ../config.mk 11 | 12 | TOPDIR = .. 13 | 14 | INITDIR = $(DESTDIR)/etc/init.d 15 | 16 | XINSTALLDIRS = $(DESTDIR)/etc/init.d \ 17 | $(DESTDIR)/etc/rc0.d \ 18 | $(DESTDIR)/etc/rc1.d \ 19 | $(DESTDIR)/etc/rc2.d \ 20 | $(DESTDIR)/etc/rc3.d \ 21 | $(DESTDIR)/etc/rc4.d \ 22 | $(DESTDIR)/etc/rc5.d \ 23 | $(DESTDIR)/etc/rc6.d 24 | 25 | XINSTALLINKS = \ 26 | $(DESTDIR)/etc/rc0.d/K80$(NAME):../init.d/$(NAME) \ 27 | $(DESTDIR)/etc/rc1.d/K80$(NAME):../init.d/$(NAME) \ 28 | $(DESTDIR)/etc/rc2.d/S30$(NAME):../init.d/$(NAME) \ 29 | $(DESTDIR)/etc/rc3.d/S30$(NAME):../init.d/$(NAME) \ 30 | $(DESTDIR)/etc/rc4.d/S30$(NAME):../init.d/$(NAME) \ 31 | $(DESTDIR)/etc/rc5.d/S30$(NAME):../init.d/$(NAME) \ 32 | $(DESTDIR)/etc/rc6.d/K80$(NAME):../init.d/$(NAME) 33 | 34 | TARGETS = \ 35 | $(NAME) 36 | 37 | INSTALLFILES = \ 38 | $(INITDIR)/$(NAME) 39 | 40 | include ../rules.mk 41 | 42 | # E.O.F. Makefile 43 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | TODO 2 | README.md 3 | Copying 4 | Changelog 5 | Makefile 6 | config.mk 7 | rules.mk 8 | defaults.sample.src 9 | MANIFEST 10 | doc/arpsponge_architecture.txt 11 | doc/Makefile 12 | doc/command_mapping.txt 13 | tools/mkinstalldirs 14 | tools/bsdinst 15 | tools/rminstalldirs 16 | t/dosponge 17 | t/testqueue.pl 18 | t/dosponge2 19 | t/testpcap 20 | init.d/arpsponge.sh 21 | init.d/Makefile 22 | lib/M6/ArpSponge/Base.pm 23 | lib/M6/ArpSponge/Const.pm 24 | lib/M6/ArpSponge/Control/Base.pm 25 | lib/M6/ArpSponge/Control/Client.pm 26 | lib/M6/ArpSponge/Control/Makefile 27 | lib/M6/ArpSponge/Control.pm 28 | lib/M6/ArpSponge/Control/Server.pm 29 | lib/M6/ArpSponge/Event.pm 30 | lib/M6/ArpSponge/Log.pm 31 | lib/M6/ArpSponge/Makefile 32 | lib/M6/ArpSponge/NetPacket.pm 33 | lib/M6/ArpSponge/ReadLine.pm 34 | lib/M6/ArpSponge/Queue.pm 35 | lib/M6/ArpSponge/Sponge.pm 36 | lib/M6/ArpSponge/Table.pm 37 | lib/M6/ArpSponge/Util.pm 38 | lib/M6/Makefile 39 | lib/Makefile 40 | man/Makefile 41 | sbin/arpsponge.pl 42 | sbin/Makefile 43 | sbin/aslogtail.pl 44 | sbin/asctl.pl 45 | debian/arpsponge.init 46 | debian/arpsponge.links 47 | debian/changelog 48 | debian/compat 49 | debian/control 50 | debian/copyright 51 | debian/docs 52 | debian/rules 53 | -------------------------------------------------------------------------------- /t/testpcap: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | 4 | use strict; 5 | use Net::Pcap; 6 | use Socket; 7 | use M6::ARP::Util qw( :all ); 8 | use M6::ARP::NetPacket qw( :all ); 9 | 10 | my $err; 11 | my $pd = Net::Pcap::open_live( 12 | 'eth0', 13 | 0,0,1000,\$err 14 | ); 15 | 16 | $pd or die "Net::Pcap::open_live: $err\n"; 17 | 18 | my $src_ip = '91.200.17.40'; 19 | my $src_mac = 'fe:00:00:96:00:0a'; 20 | 21 | #my $dst_ip = '91.200.17.55'; 22 | #my $dst_mac = '00:30:48:d9:7f:8c'; 23 | my $dst_ip = '91.200.17.57'; 24 | my $dst_mac = 'ff:ff:ff:ff:ff:ff'; 25 | 26 | my $arp_packet = encode_arp({ 27 | sha => mac2hex($src_mac), 28 | spa => ip2hex($src_ip), 29 | tha => mac2hex($dst_mac), 30 | tpa => ip2hex($dst_ip), 31 | opcode => $ARP_OPCODE_REQUEST, 32 | }); 33 | 34 | my $pkt = encode_ethernet({ 35 | dest_mac => mac2hex($dst_mac), 36 | src_mac => mac2hex($src_mac), 37 | type => $ETH_TYPE_ARP, 38 | data => $arp_packet 39 | }); 40 | 41 | if (Net::Pcap::sendpacket($pd, $pkt) < 0) { 42 | print "error: $!\n"; 43 | } 44 | 45 | Net::Pcap::close($pd); 46 | -------------------------------------------------------------------------------- /debian/control: -------------------------------------------------------------------------------- 1 | Source: arpsponge 2 | Section: perl 3 | Priority: optional 4 | Maintainer: Steven Bakker 5 | Build-Depends: debhelper-compat (= 13), 6 | perl (>= 5.014), 7 | libio-string-perl (>= 1.08-3), 8 | libipc-run-perl (>= 0.92-1+deb8u1), 9 | libjson-pp-perl (>= 2.27300-2), 10 | libnet-arp-perl (>= 1.0.8-2), 11 | libnet-pcap-perl (>= 0.17-1+b2), 12 | libnetaddr-ip-perl (>= 4.075+dfsg-1+b1), 13 | libreadonly-perl (>= 2.000-1), 14 | libscalar-list-utils-perl (>= 1:1.47-1), 15 | libterm-readkey-perl (>= 2.32-1+b1), 16 | libterm-readline-gnu-perl (>= 1.17), 17 | libyaml-pp-perl (>= 0.026-1) 18 | Standards-Version: 4.3.0.3 19 | Vcs-Git: https://github.com/AMS-IX/arpsponge.git 20 | Vcs-Browser: https://github.com/AMS-IX/arpsponge 21 | 22 | Package: arpsponge 23 | Architecture: all 24 | Depends: ${misc:Depends}, 25 | iproute2, 26 | perl (>= 5.014), 27 | libio-string-perl (>= 1.08-3), 28 | libipc-run-perl (>= 0.92-1+deb8u1), 29 | libjson-pp-perl (>= 2.27300-2), 30 | libnet-arp-perl (>= 1.0.8-2), 31 | libnet-pcap-perl (>= 0.17-1+b2), 32 | libnetaddr-ip-perl (>= 4.075+dfsg-1+b1), 33 | libreadonly-perl (>= 2.000-1), 34 | libscalar-list-utils-perl (>= 1:1.47-1), 35 | libterm-readkey-perl (>= 2.32-1+b1), 36 | libterm-readline-gnu-perl (>= 1.17), 37 | libyaml-pp-perl (>= 0.026-1) 38 | Description: Nifty ARP sponge. 39 | Nifty ARP sponge featuring gratuitous ARP, sweeping, reporting, etc. 40 | Also keeps an internal ARP table which can be dumped to a file. The 41 | daemon's state can be inspected and manipulated over a control socket. 42 | -------------------------------------------------------------------------------- /tools/rminstalldirs: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # rminstalldirs --- remove directory hierarchy 4 | # 5 | # Works (almost) similar to "rmdir -ps", except that the whole path 6 | # needn't exist. For example, 7 | # 8 | # rminstalldirs /dir1/dir2/dir3/file1 9 | # 10 | # - will still remove the whole tree if "file1" does not exist. Of course 11 | # it will not remove any directory that is not empty. 12 | # 13 | # Author: Steven Bakker 14 | # Created: 1998-06-24 15 | 16 | PATH=/sbin:/bin:/usr/bin:/usr/sbin 17 | OLDIFS="$IFS" 18 | 19 | do_rmdir() { 20 | if [ `echo "$1" | sed -e 's:^/::g'` = "$1" ] 21 | then 22 | dir="`pwd`/$1" 23 | else 24 | dir=$1 25 | fi 26 | shift 27 | 28 | cd / 29 | path='' 30 | 31 | IFS=/ 32 | set - $dir 33 | IFS="$OLDIFS" 34 | 35 | # Go down the path as far as possible, keeping track of 36 | # the reverse path back up ($path). 37 | for i in $* 38 | do 39 | [ -d $i ] || break 40 | cd $i 41 | path="$i $path" 42 | done 43 | 44 | # Go up one directory, so we can "rmdir" it... 45 | cd .. 46 | 47 | # Now travel back up the tree, removing subdirs as we go... 48 | set - $path 49 | goon=true 50 | while $goon && [ $# -gt 0 ] 51 | do 52 | d=$1; shift 53 | if [ $d = . -o $d = .. ] 54 | then 55 | # "." and ".." references in the path act as sentinels. 56 | goon=false 57 | else 58 | if rmdir $d >/dev/null 2>&1 59 | then 60 | echo rmdir `pwd`/$d 61 | cd .. 62 | else 63 | # Failed "rmdir"; give up. 64 | goon=false 65 | fi 66 | fi 67 | done 68 | } 69 | 70 | for dir in "$@" 71 | do 72 | do_rmdir $dir 73 | done 74 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | #!make 2 | # Copyright 2005-2016 AMS-IX B.V. 3 | # 4 | # This is free software. It can be distributed under 5 | # your choice of the GPL or Artistic License 2.0. 6 | # 7 | # See the Copying file that came with this package. 8 | # 9 | # Notes: 10 | # All you'll probably ever need to edit is in `config.mk' 11 | # 12 | # ============================================================================ 13 | 14 | TOPDIR = . 15 | 16 | include $(TOPDIR)/config.mk 17 | include $(TOPDIR)/rules.mk 18 | 19 | TARGETS = defaults.sample 20 | 21 | default : all 22 | 23 | all : $(TARGETS) sbin-all init.d-all man-all \ 24 | lib-all doc-all 25 | 26 | install : all sbin-install init.d-install man-install \ 27 | lib-install doc-install 28 | 29 | clean : sbin-clean init.d-clean man-clean \ 30 | lib-clean doc-clean 31 | 32 | veryclean : sbin-veryclean init.d-veryclean man-veryclean \ 33 | lib-veryclean doc-veryclean 34 | 35 | #NODIST 36 | 37 | dist: 38 | @echo "creating distribution:" 39 | @echo "creating temporary area.."; \ 40 | DIR=`pwd`; \ 41 | PID=$$$$; \ 42 | $(RM) -r /tmp/$(PACKAGE).$$PID; \ 43 | mkdir -p /tmp/$(PACKAGE).$$PID/$(PACKAGE); \ 44 | \ 45 | echo "copying sources.."; \ 46 | tar -cf /tmp/$(PACKAGE).$$PID/$(PACKAGE)/dist.tar -T MANIFEST; \ 47 | cd /tmp/$(PACKAGE).$$PID/$(PACKAGE); \ 48 | tar xf dist.tar; \ 49 | $(RM) dist.tar; \ 50 | \ 51 | echo "cleaning it up"; \ 52 | make clean >/dev/null 2>&1; \ 53 | chmod -R u+w,go-w .; \ 54 | $(RM) -r $(PACKAGE); \ 55 | $$DIR/tools/mkdist Makefile > Makefile.dist; \ 56 | mv Makefile.dist Makefile; \ 57 | $$DIR/tools/mkdist config.mk > config.mk.dist; \ 58 | cp config.mk.dist config.mk; \ 59 | for script in arpsponge asctl; do \ 60 | $(perlit) sbin/$$script.pl | pod2text - $$script.txt; \ 61 | done; \ 62 | \ 63 | echo "tarring and zipping it up"; \ 64 | cd ..; \ 65 | tar czf $$DIR/$(PACKAGE).tar.gz ./$(PACKAGE); \ 66 | echo "cleaning up temporaries"; \ 67 | cd $$DIR; \ 68 | $(RM) -r /tmp/$(PACKAGE).$$PID; \ 69 | echo "phew! done!" 70 | 71 | #END-NODIST 72 | -------------------------------------------------------------------------------- /t/testqueue.pl: -------------------------------------------------------------------------------- 1 | # Test M6::ARP::Queue with flood protection. 2 | # 3 | 4 | use strict; 5 | use M6::ARP::Queue; 6 | use Time::HiRes qw( usleep time ); 7 | use POSIX qw( strftime ); 8 | 9 | my $print_table = 0; 10 | my $some_ip = '10.1.1.1'; 11 | #my @src_ip = ('10.1.1.2', '10.1.1.3', '10.1.1.4'); 12 | my @src_ip = ((map { '10.1.1.2' } (1..10000)), '10.1.1.3', '10.1.1.4'); 13 | my $max_src_rate = 5; 14 | my $max_q_rate = 70; 15 | 16 | my $q = new M6::ARP::Queue(100); 17 | 18 | printf("Filling queue for $some_ip (max %d)\n", $q->max_depth); 19 | 20 | $q->clear($some_ip); 21 | 22 | my $n = 0; 23 | for my $n (0..100) { 24 | $n++; 25 | printf("--- %3d ----------------------\n", $n); 26 | $q->add($some_ip, $src_ip[int rand(int @src_ip)], time); 27 | usleep(rand(5e5)); 28 | while (!$q->is_full($some_ip)) { 29 | my $src_ip = $src_ip[int rand(int @src_ip)]; 30 | $q->add($some_ip, $src_ip[0], time); 31 | print STDERR sprintf("\rdepth: %3d", $q->depth($some_ip)); 32 | usleep(rand(10_000)); 33 | } 34 | print "\rBefore reduce:\n"; 35 | printf(" depth: %3d\n", $q->depth($some_ip)); 36 | print strftime(" first: %H:%M:%S\n", 37 | localtime($q->get_timestamp($some_ip, 0))); 38 | print strftime(" last: %H:%M:%S\n", 39 | localtime($q->get_timestamp($some_ip, -1))); 40 | printf(" rate: %0.2f queries/minute\n", $q->rate($some_ip)); 41 | 42 | if ($print_table) { 43 | $" = ","; 44 | foreach my $entry (@{$q->get_queue($some_ip)}) { 45 | print qq{[@$entry]\n}; 46 | } 47 | } 48 | 49 | $q->reduce($some_ip, $max_src_rate); 50 | print "\nAfter reduce:\n"; 51 | printf(" depth: %3d\n", $q->depth($some_ip)); 52 | print strftime(" first: %H:%M:%S\n", 53 | localtime($q->get_timestamp($some_ip, 0))); 54 | print strftime(" last: %H:%M:%S\n", 55 | localtime($q->get_timestamp($some_ip, -1))); 56 | printf(" rate: %0.2f queries/minute\n", $q->rate($some_ip)); 57 | 58 | if ($print_table) { 59 | foreach my $entry (@{$q->get_queue($some_ip)}) { 60 | print qq{[@$entry]\n}; 61 | } 62 | } 63 | 64 | if ($q->is_full($some_ip) && $q->rate($some_ip) > $max_q_rate) { 65 | print "\n*** Done\n\n"; 66 | last; 67 | } 68 | } 69 | -------------------------------------------------------------------------------- /defaults.sample.src: -------------------------------------------------------------------------------- 1 | ############################################################################# 2 | # 3 | # This is a sample file for /etc/default/arpsponge/defaults 4 | # 5 | # The variables in this file have the installation defaults. 6 | # 7 | # Adjust to your taste. 8 | # 9 | ############################################################################# 10 | 11 | #DUMMY_MODE=true 12 | 13 | PERMISSIONS=@DFL_SOCK_PERMS@ 14 | 15 | INIT_MODE=@DFL_INIT@ 16 | LEARNING=@DFL_LEARN@ 17 | 18 | SPONGE_NETWORK=false 19 | GRATUITOUS=false 20 | 21 | QUEUE_DEPTH=@DFL_QUEUEDEPTH@ 22 | RATE=@DFL_RATE@ 23 | PENDING=@DFL_PENDING@ 24 | 25 | # Default is not to sweep. 26 | #SWEEP="900/3600" 27 | PROBERATE=@DFL_PROBERATE@ 28 | 29 | # Refresh ARP table entries after AGE 30 | AGE=@DFL_ARP_AGE@ 31 | 32 | # ARP_UPDATE_METHOD=reply,request,gratuitous 33 | # ARP_UPDATE_METHOD=all 34 | ARP_UPDATE_METHOD=none 35 | 36 | # Whether the sponge is disabled. 37 | # Can also be specified on a per-interface basis. 38 | DISABLED=false 39 | 40 | # Whether or not to send any ARP queries. 41 | # Can also be specified on a per-interface basis. 42 | PASSIVE_MODE=false 43 | 44 | # Whether or not to automatically (un)sponge. 45 | # If set to "true", the sponge will *not* automatically 46 | # sponge or unsponge addresses, i.e. you have to manually 47 | # specify this with "asctl set ip" commands, or by loading 48 | # a status table. 49 | # Can also be specified on a per-interface basis. 50 | STATIC_MODE=false 51 | 52 | # Which events to log. 53 | # Valid events: io, alien, spoof, static, sponge, ctl, state, all, none 54 | # See also arpsponge(8). 55 | # Note that negations start with '!' and that the '!' probably needs 56 | # to be escaped to avoid history expansion. 57 | ##LOGMASK='!alien' 58 | LOGMASK=all 59 | 60 | ############################################################################# 61 | # 62 | # Now, for every IFNAME you want to monitor, create an "IFNAME" file in 63 | # /etc/default/arpsponge/interfaces.d, containing at least: 64 | # 65 | # NETWORK=prefix/len 66 | # 67 | # Optional: 68 | # 69 | # STATIC_STATE_FILE=config_file_path 70 | # DEVICE=ifname 71 | # 72 | # e.g.: 73 | # 74 | # echo "NETWORK=192.168.1.0/24" > /etc/default/arpsponge/interfaces.d/eth0 75 | # 76 | # or even: 77 | # 78 | # dd of=/etc/default/arpsponge/interfaces.d/loopy <= 5.14) 15 | * Perl modules: 16 | * Carp 17 | * Config 18 | * Data::Dumper 19 | * Exporter 20 | * File::Path 21 | * FindBin 22 | * Getopt::Long 23 | * IO::File 24 | * IO::Select 25 | * IO::Socket 26 | * IO::Socket::UNIX 27 | * IO::String 28 | * IPC::Run 29 | * JSON::PP 30 | * NetAddr::IP 31 | * Net::ARP 32 | * Net::Pcap 33 | * Pod::Text::Termcap 34 | * Pod::Usage 35 | * POSIX 36 | * Readonly 37 | * Scalar::Util 38 | * Sys::Syslog 39 | * Term::ReadKey 40 | * Term::ReadLine 41 | * Term::ReadLine::Gnu 42 | * Time::HiRes 43 | * YAML::PP 44 | 45 | Depending on your O/S distribution and version of Perl, some or all of these may already be included in a base install of Perl. 46 | 47 | ## Installation 48 | 49 | ### DEBIAN 50 | 51 | 1. Edit config.mk if necessary (see below) 52 | 2. Run `make dpkg` 53 | 3. `dpkg --install *.deb` 54 | 55 | ### OTHER SYSTEMS 56 | 57 | 1. The `config.mk` should be able to detect your OS/distro automatically. If not, you may need to edit `config.mk` and set an explicit value. 58 | 2. Make sure the following variables are set correctly, either by the `DISTRO` selection or by overriding them. 59 | * `PERL` 60 | * `IFCONFIG` 61 | * `SPONGE_VAR` 62 | * `RUNDIR` 63 | * `ETC_DEFAULT` 64 | 3. If you want, you can override any of the variables below: 65 | * `DIRPREFIX` 66 | * `BINPREFIX` 67 | * `DOCPREFIX` 68 | * `BINDIR` 69 | * `LIBROOT` 70 | * `INSTLIB` 71 | * `MANDIR` 72 | * `DOCDIR` 73 | * `SECTION` 74 | * `FILESECTION` 75 | 5. run `make` (or `gmake` on BSD). 76 | 77 | 6. run `make install` (`gmake install` on BSD). 78 | 79 | ## Documentation 80 | 81 | See the `arpsponge` man page, or `perldoc arpsponge`. 82 | 83 | # FreeBSD Notes 84 | 85 | Installing dependencies: 86 | 87 | ``` 88 | pkg install gmake \ 89 | perl5 \ 90 | p5-Net-Pcap p5-Readonly p5-NetAddr-IP p5-IO-String \ 91 | p5-Net-Arp p5-Term-ReadKey p5-Term-ReadLine-Gnu p5-IPC-Run \ 92 | p5-YAML-PP p5-JSON-PP 93 | ``` 94 | -------------------------------------------------------------------------------- /tools/bsdinst: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # bsdinst.sh: BSD-like install program 4 | # 5 | # Not all BSD install options are supported, and one extra is added: 6 | # 7 | # -l logfile 8 | 9 | prog=`basename $0` 10 | 11 | PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin:/usr/ucb 12 | export PATH 13 | 14 | usage() { 15 | echo "$@" >&2 16 | echo "usage: $prog [options] file ... destination" >&2 17 | echo "options: [-cs] [-l logfile] [-g group] [-m mode] [-o owner]" >&2 18 | exit 1; 19 | } 20 | 21 | verbose=false 22 | go_on=true 23 | copy=true 24 | strip=false 25 | 26 | mode=755 27 | logfile='' 28 | 29 | [ `whoami` = root ] && root=true || root=false 30 | 31 | if $root; then 32 | owner=root 33 | group=staff 34 | fi 35 | 36 | while [ $# -gt 0 ] && $go_on 37 | do 38 | case X:$1 in 39 | X:-s) shift 40 | strip=true ;; 41 | X:-c) shift 42 | copy=true ;; 43 | X:-cs |\ 44 | X:-sc) shift 45 | copy=true 46 | strip=true ;; 47 | X:-l) shift 48 | logfile=$1 49 | shift ;; 50 | X:-g) shift 51 | if $root; then 52 | group=$1 53 | elif $verbose; then 54 | echo "warning: \"-g\" flag ignored (not super-user)" >&2 55 | fi 56 | shift ;; 57 | X:-m) shift 58 | mode=$1 59 | shift;; 60 | X:-d) usage "\"-d\" flag is not supported (sorry)" ;; 61 | X:-v) shift 62 | verbose=true ;; 63 | X:-o) shift 64 | if $root; then 65 | owner=$1 66 | elif $verbose; then 67 | echo "warning: \"-o\" flag ignored (not super-user)" >&2 68 | fi 69 | shift ;; 70 | X:---) shift; go_on=false;; 71 | X:-*) usage "unknown option \"$1\"" ;; 72 | X:*) go_on=false ;; 73 | esac 74 | done 75 | 76 | if [ $# -lt 2 ]; then 77 | usage "too few arguments" 78 | elif [ $# -gt 2 ]; then 79 | multiple_src=true 80 | else 81 | multiple_src=false 82 | fi 83 | 84 | while [ $# -gt 1 ] 85 | do 86 | files="$files $1" 87 | shift 88 | done 89 | 90 | destination=$1 91 | 92 | [ -d "$destination" ] && dst_is_a_file=false || dst_is_a_file=true 93 | 94 | if $multiple_src && $dst_is_a_file 95 | then 96 | usage 97 | fi 98 | 99 | set $files 100 | 101 | $copy && mvcp=cp || mvcp=mv 102 | 103 | for file 104 | do 105 | $dst_is_a_file && dst_file=$destination || \ 106 | dst_file=$destination/`basename $file` 107 | 108 | $verbose && echo + $mvcp $file $dst_file 109 | rm -f $dst_file 110 | $mvcp $file $dst_file || exit 1 111 | 112 | if [ -n "$logfile" ]; then 113 | echo $dst_file >> $logfile 114 | fi 115 | 116 | if [ -n "$mode" ]; then 117 | chmod 600 $dst_file 118 | $verbose && echo + chmod $mode $dst_file 119 | chmod $mode $dst_file > /dev/null 2>&1 120 | [ $? = 0 ] || \ 121 | echo "$dst_file: could not chmod (ignored)" >&2 122 | fi 123 | 124 | if $strip; then 125 | $verbose && echo + strip $dst_file 126 | strip $dst_file >/dev/null 2>&1 127 | [ $? = 0 ] || \ 128 | echo "$dst_file: could not strip (ignored)" >&2 129 | fi 130 | 131 | if [ -n "$owner" ]; then 132 | $verbose && echo + chown $owner $dst_file 133 | chown $owner $dst_file >/dev/null 2>&1 134 | [ $? = 0 ] || \ 135 | echo "$dst_file: could not chown (ignored)" >&2 136 | fi 137 | 138 | if [ -n "$group" ]; then 139 | $verbose && echo + chgrp $group $dst_file 140 | chgrp $group $dst_file >/dev/null 2>&1 141 | [ $? = 0 ] || \ 142 | echo "$dst_file: could not chgrp (ignored)" >&2 143 | fi 144 | done 145 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Table.pm: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # 3 | # ARP Table 4 | # 5 | # Copyright 2005-2016 AMS-IX B.V.; All rights reserved. 6 | # 7 | # This module is free software; you can redistribute it and/or 8 | # modify it under the same terms as Perl itself. See perldoc 9 | # perlartistic. 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. 14 | # 15 | # See the "Copying" file that came with this package. 16 | # 17 | # S.Bakker, 2005 18 | # 19 | ############################################################################### 20 | package M6::ArpSponge::Table; 21 | 22 | use strict; 23 | 24 | use Time::HiRes qw( time ); 25 | 26 | BEGIN { 27 | our $VERSION = 1.03; 28 | } 29 | 30 | =pod 31 | 32 | =head1 NAME 33 | 34 | M6::ArpSponge::Table - keep a table of ARP entries 35 | 36 | =head1 SYNOPSIS 37 | 38 | use M6::ArpSponge::Table; 39 | 40 | $table = new M6::ArpSponge::Table; 41 | 42 | $table->clear($some_ip); 43 | $table->add($some_ip, $some_mac); 44 | 45 | $mac = $table->arp($some_ip); 46 | $stamp = $table->mtime($some_ip); 47 | @iplist = $table->rarp($mac); 48 | 49 | @iplist = $table->ip_list; 50 | @maclist = $table->mac_list; 51 | 52 | =head1 DESCRIPTION 53 | 54 | This object class can be used by network monitoring processes to keep 55 | track of IP to MAC mappings. 56 | 57 | =head1 CONSTRUCTOR 58 | 59 | =over 60 | 61 | =item XB 62 | 63 | Create a new object instance and return a reference to it. 64 | 65 | =cut 66 | 67 | sub new { 68 | my ($type, $max_depth) = @_; 69 | 70 | $type = ref $type if ref $type; 71 | bless { arp => {}, rarp => {} }, $type; 72 | } 73 | 74 | =back 75 | 76 | =head1 METHODS 77 | 78 | =over 79 | 80 | =item XB ( I ) 81 | 82 | Clear the ARP table for I. 83 | 84 | =cut 85 | 86 | sub clear { 87 | my ($self, $ip) = @_; 88 | 89 | if (my $mac = $self->arp($ip)) { 90 | delete $self->{rarp}->{$mac}->{$ip}; 91 | } 92 | delete $self->{arp}->{$ip}; 93 | } 94 | 95 | =item XB ( I ) 96 | 97 | Return the MAC address for I. Returns C if there is no 98 | entry for I. 99 | 100 | =cut 101 | 102 | sub arp { $_[0]->{'arp'}->{$_[1]} } 103 | 104 | =item XB ( I ) 105 | 106 | Return an unsorted list of IP addresses that are mapped to I. 107 | 108 | =cut 109 | 110 | sub rarp { keys %{$_[0]->{'rarp'}->{$_[1]}} } 111 | 112 | =item XB 113 | 114 | Return an unsorted list of IP addresses that are present in the ARP table. 115 | 116 | =cut 117 | 118 | sub ip_list { keys %{$_[0]->{'arp'}} } 119 | 120 | =item XB 121 | 122 | Return an unsorted list of MAC addresses that are present in the ARP table. 123 | 124 | =cut 125 | 126 | sub mac_list { sort { ip_sort($a, $b) } keys %{$_[0]->{'rarp'}} } 127 | 128 | =item XB ( I, I [, I] ) 129 | 130 | Add I to I mapping to the table. If I is given, use 131 | it for the entry's timestamp, otherwise use the current time. 132 | Returns the timestamp. 133 | 134 | =cut 135 | 136 | sub add { 137 | my ($self, $ip, $mac, $timestamp) = @_; 138 | $timestamp //= time; 139 | $self->clear($ip); 140 | $self->{'arp'}->{$ip} = $mac; 141 | $self->{'rarp'}->{$mac}->{$ip} = $timestamp; 142 | return $timestamp; 143 | } 144 | 145 | 1; 146 | 147 | __END__ 148 | 149 | =back 150 | 151 | =head1 EXAMPLE 152 | 153 | See the L section. 154 | 155 | =head1 SEE ALSO 156 | 157 | L, L. 158 | 159 | =head1 AUTHORS 160 | 161 | Steven Bakker at AMS-IX (steven.bakker@ams-ix.net). 162 | 163 | =head1 COPYRIGHT 164 | 165 | Copyright 2005-2016, AMS-IX B.V. 166 | Distributed under GPL and the Artistic License 2.0. 167 | 168 | =cut 169 | -------------------------------------------------------------------------------- /doc/command_mapping.txt: -------------------------------------------------------------------------------- 1 | Overview of commands / communication between client and server. 2 | 3 | Basic (socket-level) Communications 4 | ----------------------------------- 5 | 6 | LF = line-feed (\n) 7 | FF = form-feed (\f) 8 | TAB = tab (\t) 9 | 10 | * Client sends single-line commands to server, terminated by LF. 11 | 12 | * Server sends two kinds of reply "log_msg" and "command_output": 13 | 14 | reply := log_msg | command_output 15 | log_msg := log_hdr + text + LF 16 | log_hdr := FF + "LOG" + TAB 17 | command_output := ( text + LF )* + ready_prompt 18 | ready_prompt : = FF + "READY" + LF 19 | 20 | 1. Log messages: 21 | 22 | Should be read by the client and buffered internally. Show log 23 | and clear log display and clear this internal buffer. 24 | 25 | 2. Command output: 26 | 27 | All text up to (but not including) the ready_prompt. 28 | 29 | Log messages are sent by the server whenever it has something to log. 30 | Hence, a client may receive zero or more log messages when it waits 31 | for command output. 32 | 33 | Server commands 34 | --------------- 35 | 36 | clear_arp 37 | clear_ip 38 | clear_ip_all 39 | get_arp 40 | get_ip 41 | get_log 42 | get_status 43 | inform 44 | ping 45 | quit 46 | set_alive 47 | set_dead 48 | set_dummy 49 | set_flood_protection 50 | set_learning 51 | set_max_pending 52 | set_max_rate 53 | set_pending 54 | set_proberate 55 | set_queuedepth 56 | set_sweep_age 57 | set_sweep_sec 58 | 59 | Command mappings 60 | ---------------- 61 | 62 | Client Server 63 | ----------------------------------- 64 | clear arp X clear_arp X 65 | clear ip X clear_ip X 66 | ping [N [S]] ping N S 67 | quit quit 68 | 69 | set ip X alive [Y] set_alive X Y 70 | set ip X dead set_dead X 71 | set ip X mac Y set_alive X Y 72 | set ip X pending N set_pending X Y 73 | set ip X queue N set_queue X Y 74 | set ip X rate Y set_rate X Y 75 | 76 | set dummy F set_dummy F 77 | set flood-protection R set_flood_protection R 78 | set learning S set_learning S 79 | set max-pending N set_max_pending N 80 | set max-rate R set_max_rate R 81 | set proberate R set_proberate R 82 | set queuedepth N set_queuedepth N 83 | set sweep age S set_sweep_age S 84 | set sweep period S set_sweep_sec S 85 | 86 | show arp [X] get_arp X 87 | show ip [X] get_ip X 88 | 89 | show log [N] get_log N 90 | show status get_status 91 | show uptime get_status 92 | show version get_status 93 | sponge X set_dead X 94 | unsponge X set_alive X 95 | 96 | Data Types 97 | ---------- 98 | 99 | X: IP addres (hexstring) 100 | Y: MAC address (hexstring) 101 | N: integer > 0 102 | S: seconds (float) 103 | T: seconds (int) 104 | R: rate (float) 105 | F: boolean 106 | 107 | IP addresses are sent as hexadecimal strings. 108 | MAC addresses are sent as hexadecimal strings. 109 | Boolean values are sent as 0 or 1. 110 | Time stamps are sent as seconds since epoch. 111 | 112 | Server: 113 | 114 | Output is sent as = , with 115 | between records. 116 | 117 | ----------------------------- 118 | 119 | ip=1c201a6f 120 | state=ALIVE 121 | queue=0 122 | rate=0.0 123 | state_mtime=1301071508 124 | state_atime=1301071567 125 | 126 | ip=1c201a70 127 | state=DEAD 128 | queue=500 129 | rate=60.0 130 | state_mtime=1301071402 131 | state_atime=1301071663 132 | 133 | [OK] 134 | 135 | ----------------------------- 136 | 137 | id=arpsponge 138 | pid=3456 139 | version=3.10-alpha2(110) 140 | date=1301071803 141 | started=1300897051 142 | network=5bc81100 143 | prefixlen=26 144 | interface=eth0 145 | ip=5bc81128 146 | mac=fe000096000a 147 | max_queue=200 148 | max_rate=30.00 149 | flood_protection=5.00 150 | max_pending=10 151 | sweep_period=900 152 | sweep_age=3600 153 | proberate=100 154 | next_sweep=38 155 | learning=0 156 | dummy=1 157 | 158 | [OK] 159 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | @(#) $Id$ 2 | 3 | -------------------------------------------------- 4 | Tue Mar 29 23:13:42 CEST 2011 5 | 6 | Internal storage of IP and MAC addresses is now done 7 | as hex strings. 8 | 9 | Need to rework the client/server protocol, so the 10 | client also sends and receives HEX strings. See the 11 | doc/command_mapping.txt file. 12 | 13 | -------------------------------------------------- 14 | Wish list for future enhancements: 15 | 16 | * setuid() to unprivileged user after opening relevant streams. 17 | 18 | * use ithreads for better real-time behaviour: 19 | 20 | - process 21 | - learner 22 | - sweeper 23 | - prober 24 | 25 | Process: Always active, listens to packets on the wire. 26 | Handles ALIVE->PENDING and DEAD->ALIVE, manages 27 | the ARP table. 28 | 29 | Learner: stays active for "n" iterations, then finishes. 30 | 31 | Prober: waits for Learner to finish, then every second, probes 32 | the IPs that are PENDING, moving them to DEAD if necessary. 33 | 34 | Sweeper: waits for Learner to finish, then periodically probes 35 | "quiet" IPs. 36 | 37 | -------------------------------------------------- 38 | Wed Mar 23 17:45:17 CET 2011 39 | 40 | * DONE: speed improvements: 41 | 42 | MAC and IP addresses already come in as hex strings. 43 | We currently use "hex2ip" and "hex2mac" to convert them 44 | before storing them in the relevant hashes. 45 | 46 | Why not keep them in hex form and convert to proper strings 47 | when needed? 48 | 49 | Also, using hex form only, there's a smart algorithm 50 | for checking whether an IP address is in a network, which 51 | dramatically cuts down on the packet handling loop. 52 | 53 | #!/usr/bin/perl 54 | 55 | use M6::ARP::Util qw( :all ); 56 | use Benchmark qw( cmpthese ); 57 | use Net::IPv4Addr qw( :all ); 58 | 59 | my $ip = '193.194.136.192'; 60 | my $net = '193.194.136.128'; 61 | my $mask = '255.255.255.128'; 62 | my $len = 25; 63 | 64 | if (1) { 65 | my $hexip = ip2hex($ip); 66 | my $hexnet = ip2hex($net); 67 | cmpthese($count, { 68 | 'ipv4_in_network' => 69 | sub { 70 | my $bool = ipv4_in_network($net, $mask, $ip); 71 | }, 72 | 'addr_in_net' => 73 | sub { 74 | my $bool = addr_in_net(ip2hex($ip), ip2hex($net), $len) 75 | }, 76 | 'addr_in_net2' => 77 | sub { 78 | my $bool = addr_in_net($hexip, $hexnet, $len) 79 | }, 80 | }); 81 | } 82 | 83 | sub addr_in_net { 84 | my ($addr, $net, $len) = @_; 85 | 86 | my $nibbles = int($len / 4); 87 | 88 | if ($nibbles) { 89 | if (substr($addr, 0, $nibbles) ne substr($net, 0, $nibbles)) { 90 | return; 91 | } 92 | } 93 | 94 | $len = $len % 4; 95 | 96 | return 1 if !$len; 97 | 98 | my $mask = 0xf & ~( 1<<(4-$len) - 1 ); 99 | my $a = hex(substr($addr,$nibbles,1)); 100 | my $n = hex(substr($net,$nibbles,1)); 101 | return ($a & $mask) == $n; 102 | } 103 | 104 | 105 | -------------------------------------------------- 106 | Thu Oct 7 09:16:50 CEST 2010 107 | 108 | [Implemented first approach] 109 | 110 | Add flood protection by somehow limiting the significance of 111 | ARP queries if they all come from the same source. 112 | 113 | Possible approaches: 114 | 115 | * Add src_ip to the queue as well, and when the queue is full, collapse 116 | entries of the same source if they are timed too closely together (say, 117 | less than 750ms). 118 | 119 | * Take list: 120 | [t0, s1], [t1, s2], [t2, s2], [t3, s1], [t4, s2], [t5, s2] 121 | 122 | * Sort by SRC, then TIMESTAMP: 123 | [t0, s1], [t3, s1], [t1, s2], [t2, s2], [t4, s2], [t5, s2] 124 | 125 | * Reduce closely spaced entries from the same SRC: 126 | [t0, s1], [t3, s1], [t1, s2], [t4, s2] 127 | 128 | * Sort by TIMESTAMP again: 129 | [t0, s1], [t1, s2], [t3, s1], [t4, s2] 130 | 131 | Advantage: works even if multiple sources are spamming us with 132 | ARP queries. 133 | 134 | Disadvantage: more state to keep, more processing when queue is 135 | full 136 | 137 | * Add "last_src" to Queue. An ARP is only added if the source 138 | does not match last_src, OR the difference in timestamps is 139 | > 750ms. 140 | 141 | Advantage: less state to keep, less processing when queue is full 142 | Disadvantage: multiple flooding sources can still cause sponging, 143 | extra overhead for adding _each_ entry to the queue. 144 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Control.pm: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # 3 | # ARP sponge control socket. 4 | # 5 | # Copyright 2011-2016 AMS-IX B.V.; All rights reserved. 6 | # 7 | # This module is free software; you can redistribute it and/or 8 | # modify it under the same terms as Perl itself. See perldoc 9 | # perlartistic. 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. 14 | # 15 | # See the "Copying" file that came with this package. 16 | # 17 | # S.Bakker, 2011 18 | # 19 | ############################################################################### 20 | package M6::ArpSponge::Control; 21 | 22 | use strict; 23 | 24 | BEGIN { 25 | our $VERSION = '0.02'; 26 | } 27 | 28 | our $Error = undef; 29 | our $BUFSIZ = 8*1024; # Max. buffer we read at once. 30 | our $MAXLOGLINES = 1024; # Max no. of log lines to keep in buffer. 31 | 32 | sub error { return $Error }; 33 | 34 | sub _set_error { 35 | $Error = join('', @_[1..$#_]); 36 | return; 37 | } 38 | 39 | 1; 40 | 41 | __END__ 42 | 43 | =pod 44 | 45 | =head1 NAME 46 | 47 | M6::ArpSponge::Control - client/server implementation for arpsponge control 48 | 49 | =head1 SYNOPSIS 50 | 51 | use M6::ArpSponge::Control; 52 | 53 | M6::ArpSponge::Control->_set_error("something scwewwy"); 54 | 55 | print M6::ArpSponge::Control->error, "\n"; 56 | 57 | $M6::ArpSponge::Control::BUFSIZ = 8*1024; 58 | $M6::ArpSponge::Control::MAXLOGLINES = 1024; 59 | 60 | # Modules that actually do some work: 61 | use M6::ArpSponge::Control::Base; 62 | use M6::ArpSponge::Control::Server; 63 | use M6::ArpSponge::Control::Client; 64 | 65 | =head1 DESCRIPTION 66 | 67 | The C modules implement a simple client/server 68 | protocol for controlling the ARP sponge using UNIX domain sockets. 69 | 70 | The server (L) uses a 71 | L 72 | object, the client (L) uses 73 | L. 74 | 75 | The implementation consists of a fairly thin wrapper around 76 | L(3p), with sponge command handling in the 77 | L 78 | part. 79 | 80 | You will probably never have to deal with this module directly, 81 | but rather use 82 | L 83 | or 84 | L. 85 | 86 | =head1 PROTOCOL 87 | 88 | =head2 General 89 | 90 | The basic protocol implemented by this module is very simple: 91 | 92 | =over 93 | 94 | =item 1. 95 | 96 | Client connects to server. 97 | 98 | =item 2. 99 | 100 | Server responds with "\014READY\n" 101 | 102 | =item 3. 103 | 104 | Client issues command, sent as one line, terminated with a newline. 105 | 106 | =item 4. 107 | 108 | Server handles command and sends a reply, followed by "\014READY\n". 109 | 110 | =back 111 | 112 | =head2 Logging 113 | 114 | The server may send unsollicited logging data to the client 115 | which is prefixed by "\014LOG\t" and terminated with a newline. 116 | 117 | The client should be aware that these lines can show up where 118 | normal command output is expected. 119 | 120 | The 121 | L 122 | object knows how to handle this and will store logging information 123 | in an internal buffer. 124 | 125 | =head1 VARIABLES 126 | 127 | =over 128 | 129 | =item X<$M6::ArpSponge::Control::Error>I<$M6::ArpSponge::Control::Error> 130 | 131 | Global control socket error message. Use 132 | L<_set_error|/_set_error> and L 133 | to manipulate this variable. 134 | 135 | =item X<$M6::ArpSponge::Control::BUFSIZ>I<$M6::ArpSponge::Control::BUFSIZ> 136 | 137 | Maximum size of data chunk we try to read in at once. See also 138 | L. 139 | 140 | =item X<$M6::ArpSponge::Control::MAXLOGLINES>I<$M6::ArpSponge::Control::MAXLOGLINES> 141 | 142 | Maximum number of log lines that a 143 | L should buffer internally. 144 | 145 | =back 146 | 147 | =head1 CLASS METHODS 148 | 149 | The following must be called as B>I. 150 | 151 | =over 152 | 153 | =item XB 154 | 155 | Return latest error reported by any control socket connection. 156 | 157 | =item X<_set_error>B<_set_error> ( I ... ) 158 | 159 | Set the control socket error string. Should be called as a class 160 | method. 161 | 162 | =back 163 | 164 | =head1 EXAMPLE 165 | 166 | See the L section. 167 | 168 | =head1 SEE ALSO 169 | 170 | L, 171 | L, 172 | L, 173 | L(3), 174 | L(3), 175 | L(8), L(1). 176 | 177 | =head1 AUTHORS 178 | 179 | Steven Bakker at AMS-IX (steven.bakker@ams-ix.net). 180 | 181 | =head1 COPYRIGHT 182 | 183 | Copyright 2011-2016, AMS-IX B.V. 184 | Distributed under GPL and the Artistic License 2.0. 185 | 186 | =cut 187 | -------------------------------------------------------------------------------- /config.mk: -------------------------------------------------------------------------------- 1 | #!make 2 | # ============================================================================ 3 | # 4 | # CONFIG.MK: Installation preferences 5 | # 6 | # Copyright 2005-2016 AMS-IX B.V.; All rights reserved. 7 | # 8 | # This module is free software; you can redistribute it and/or 9 | # modify it under the same terms as Perl itself. See perldoc 10 | # perlartistic. 11 | # 12 | # This program is distributed in the hope that it will be useful, 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 15 | # 16 | # See the "Copying" file that came with this package. 17 | # 18 | # ============================================================================ 19 | # 20 | 21 | # ---------------------------------------------------------------------------- 22 | # MANDATORY CONFIG SECTION 23 | # ---------------------------------------------------------------------------- 24 | 25 | #### OS Specific - pick one, comment out the others. 26 | #DISTRO := freebsd 27 | #DISTRO := fedora 28 | #DISTRO := redhat 29 | #DISTRO := ubuntu 30 | #DISTRO := debian 31 | 32 | ifeq (${DISTRO},) 33 | $(info --------------------------) 34 | $(info Detecting DISTRO and OS...) 35 | OS := $(shell uname -s | tr '[:upper:]' '[:lower:]') 36 | DISTRO := ? 37 | ifeq (${OS}, linux) 38 | DISTRO := $(shell grep -E "^ID=" /etc/os-release | cut -f2 -d=) 39 | else 40 | _is_bsd := $(shell echo ${OS} | grep -E bsd) 41 | ifneq (${_is_bsd},) 42 | DISTRO := ${OS} 43 | DISTRO_FLAVOR := ${OS} 44 | OS := bsd 45 | endif 46 | endif 47 | $(info > OS = ${OS}) 48 | $(info > DISTRO = ${DISTRO}) 49 | $(info --------------------------) 50 | endif 51 | 52 | # Defaults apply for Linux 53 | PERL = /usr/bin/perl 54 | LIBROOT = $(DIRPREFIX)/lib/perl5 55 | IFCONFIG = /sbin/ifconfig 56 | OWNER = root 57 | GROUP = root 58 | DFL_SOCK_GROUP = adm 59 | RUNDIR = /run 60 | ETC_DEFAULT = /etc/default 61 | 62 | ifeq (${DISTRO},freebsd) 63 | OS = bsd 64 | DISTRO_FLAVOR = freebsd 65 | else ifneq (, $(filter ${DISTRO},fedora redhat)) 66 | OS = linux 67 | DISTRO_FLAVOR = redhat 68 | else ifneq (,$(filter ${DISTRO},debian ubuntu)) 69 | OS = linux 70 | DISTRO_FLAVOR = debian 71 | else 72 | $(error unknown DISTRO "${DISTRO}") 73 | endif 74 | 75 | ifeq (${OS},bsd) 76 | PERL = /usr/local/bin/perl 77 | LIBROOT = $(DIRPREFIX)/lib/perl5/site_perl 78 | GROUP = wheel 79 | DFL_SOCK_GROUP = wheel 80 | RUNDIR = /var/run 81 | ifeq (${DISTRO},openbsd) 82 | # OpenBSD has no /etc/default or /etc/defaults :-( 83 | ETC_DEFAULT = /etc 84 | else 85 | ETC_DEFAULT = /etc/defaults 86 | endif 87 | else ifeq (${OS},linux) 88 | ifeq (${DISTRO_FLAVOR},debian) 89 | LIBROOT = $(DIRPREFIX)/lib/site_perl 90 | endif 91 | endif 92 | 93 | # --------------------------------------------------------------------------- 94 | # OVERRIDES 95 | # --------------------------------------------------------------------------- 96 | 97 | # --------------------------------------------------------------------------- 98 | # SPONGE DEFAULTS 99 | # --------------------------------------------------------------------------- 100 | 101 | DFL_RATE = 50 102 | DFL_QUEUEDEPTH = 1000 103 | DFL_ARP_AGE = 600 104 | DFL_PENDING = 5 105 | DFL_PROBERATE = 100 106 | DFL_FLOOD_PROTECTION = 3.0 107 | DFL_INIT = ALIVE 108 | DFL_LEARN = 5 109 | DFL_LOGLEVEL = info 110 | 111 | DFL_SOCK_PERMS = root:$(DFL_SOCK_GROUP):0660 112 | SPONGE_VAR = /var/run/$(NAME) 113 | 114 | # ---------------------------- 115 | # --- Installation details --- 116 | # ---------------------------- 117 | 118 | MODE = 644 119 | BINMODE = 755 120 | 121 | # ---------------------------------------------------------------------------- 122 | # OPTIONAL SECTION 123 | # ---------------------------------------------------------------------------- 124 | 125 | # ------------------------------------------------------ 126 | # --- Locations for scripts, libraries, manual pages --- 127 | # ------------------------------------------------------ 128 | 129 | # Prefix for most directories 130 | DIRPREFIX = $(DESTDIR)/usr/local 131 | 132 | BINPREFIX = $(DIRPREFIX) 133 | DOCPREFIX = $(DIRPREFIX)/share 134 | 135 | # Where to install perl scripts, jobs, library files and manual pages. 136 | BINDIR = $(BINPREFIX)/sbin 137 | 138 | INSTLIB = $(LIBROOT) 139 | MANDIR = $(DIRPREFIX)/man 140 | DOCDIR = $(DOCPREFIX)/doc/$(NAME)-$(RELEASE) 141 | 142 | # What section for the manual pages? 143 | SECTION = 8 144 | FILESECTION = 4 145 | 146 | # ---------------------------------------------------------------------------- 147 | # END OPTIONAL SECTION 148 | # ---------------------------------------------------------------------------- 149 | 150 | # Don't change this. This is for people with a brain damaged csh(1). 151 | # Well, you may change it, as long as it points to a Bourne-like shell. 152 | SHELL = /bin/sh 153 | 154 | LIBDIR = $(LIBROOT) 155 | TOOLDIR = $(TOPDIR)/tools 156 | AUTODIR = . 157 | CURRDIR = . 158 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Const.pm: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # 3 | # ARP Sponge Flags 4 | # 5 | # Copyright 2011-2016 AMS-IX B.V.; All rights reserved. 6 | # 7 | # This module is free software; you can redistribute it and/or 8 | # modify it under the same terms as Perl itself. See perldoc 9 | # perlartistic. 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. 14 | # 15 | # See the "Copying" file that came with this package. 16 | # 17 | # S.Bakker, 2011; 18 | # 19 | ############################################################################### 20 | package M6::ArpSponge::Const; 21 | 22 | use strict; 23 | 24 | use base qw( Exporter ); 25 | 26 | BEGIN { 27 | our $VERSION = 1.02; 28 | 29 | my @func = qw( 30 | parse_update_flags update_flags_to_str is_valid_state 31 | state_to_string 32 | ); 33 | my @states = qw( STATIC DEAD ALIVE PENDING NONE ); 34 | my @update_flags = qw( 35 | ARP_UPDATE_REPLY 36 | ARP_UPDATE_REQUEST 37 | ARP_UPDATE_GRATUITOUS 38 | ARP_UPDATE_NONE 39 | ARP_UPDATE_ALL 40 | ); 41 | 42 | our @EXPORT_OK = ( @func, @states, @update_flags ); 43 | our @EXPORT = (); 44 | 45 | our %EXPORT_TAGS = ( 46 | 'func' => \@func, 47 | 'states' => \@states, 48 | 'flags' => \@update_flags, 49 | 'all' => [ @func, @states, @update_flags ] 50 | ); 51 | } 52 | 53 | use constant ARP_UPDATE_REPLY => 0x01; 54 | use constant ARP_UPDATE_REQUEST => 0x02; 55 | use constant ARP_UPDATE_GRATUITOUS => 0x04; 56 | use constant ARP_UPDATE_NONE => 0x00; 57 | use constant ARP_UPDATE_ALL => 0x07; 58 | 59 | our %UPDATE_FLAG_TO_STR = ( 60 | ARP_UPDATE_REPLY() => 'reply', 61 | ARP_UPDATE_REQUEST() => 'request', 62 | ARP_UPDATE_GRATUITOUS() => 'gratuitous', 63 | ); 64 | 65 | our %STR_TO_UPDATE_FLAG = ( 66 | 'none' => ARP_UPDATE_NONE, 67 | 'all' => ARP_UPDATE_ALL, 68 | map { ($UPDATE_FLAG_TO_STR{$_} => $_) } keys %UPDATE_FLAG_TO_STR, 69 | ); 70 | 71 | # State constants/macros 72 | use constant STATIC => -3; 73 | use constant DEAD => -2; 74 | use constant ALIVE => -1; 75 | 76 | sub PENDING { 0 + $_[$#_] }; 77 | 78 | our %STATE_TO_STR = ( 79 | STATIC() => 'STATIC', 80 | DEAD() => 'DEAD', 81 | ALIVE() => 'ALIVE', 82 | ); 83 | 84 | our %STR_TO_STATE = ( 85 | 'PENDING' => PENDING(0), 86 | map { ($STATE_TO_STR{$_} => $_) } keys %STATE_TO_STR, 87 | ); 88 | 89 | =over 90 | 91 | =item B ( I ) 92 | X 93 | 94 | =cut 95 | 96 | sub state_to_string { 97 | my ($state) = @_; 98 | 99 | return 'NONE' if !defined $state; 100 | return $STATE_TO_STR{$state} // 'ILLEGAL' if $state < PENDING(0); 101 | return sprintf("PENDING(%d)", $state - PENDING(0)); 102 | } 103 | 104 | =over 105 | 106 | =item B ( I [, B<-err =E> I ) 107 | X 108 | 109 | =cut 110 | 111 | sub is_valid_state { 112 | my $arg = uc $_[0]; 113 | my $err_s; 114 | my %opts = (-err => \$err_s, @_[1..$#_]); 115 | 116 | $arg =~ s/^\s+//; 117 | $arg =~ s/\s+$//; 118 | 119 | return $STR_TO_STATE{$arg} if exists $STR_TO_STATE{$arg}; 120 | 121 | ${$opts{-err}} = q/"$arg" is not a valid state/; 122 | return; 123 | } 124 | 125 | =item B ( I [, B<-err> =E I] ) 126 | X 127 | 128 | Check whether I represents a valid list of ARP update flags. Returns an 129 | integer representing the flags on success, C on error. Note that an 130 | undefined I is still valid, and represents C. 131 | 132 | If an error occurs, and C<-err> is specified, the scalar behind I will 133 | contain a diagnostic. 134 | 135 | =cut 136 | 137 | sub parse_update_flags { 138 | my ($arg, @opts) = @_; 139 | my $err_s; 140 | my %opts = (-err => \$err_s, @opts); 141 | 142 | my $flags = ARP_UPDATE_NONE; 143 | return $flags if ! defined $arg; 144 | for my $method (split(/\s*,\s*/, lc $arg)) { 145 | my $negate = 0; 146 | if ($method =~ s/^\!//) { 147 | $negate = 1; 148 | } 149 | if ($method eq 'none') { 150 | $method = 'all'; 151 | $negate = !$negate; 152 | } 153 | 154 | if (! exists $STR_TO_UPDATE_FLAG{$method}) { 155 | ${$opts{-err}} = qq/"$method" is not a valid ARP update flag/; 156 | return; 157 | } 158 | 159 | if ($negate) { 160 | $flags &= ~ $STR_TO_UPDATE_FLAG{$method}; 161 | next; 162 | } 163 | $flags |= $STR_TO_UPDATE_FLAG{$method}; 164 | } 165 | return $flags; 166 | } 167 | 168 | =item B ( I ) 169 | X 170 | 171 | Translate the bits in I to ARP update flag names and return a list of 172 | them. 173 | 174 | =cut 175 | 176 | sub update_flags_to_str { 177 | my ($arg) = @_; 178 | my @list; 179 | 180 | if ($arg == ARP_UPDATE_NONE) { 181 | return ('none'); 182 | } 183 | for my $mask ( sort keys %UPDATE_FLAG_TO_STR ) { 184 | if ($arg & $mask) { 185 | push @list, $UPDATE_FLAG_TO_STR{$mask}; 186 | } 187 | } 188 | return @list; 189 | } 190 | 191 | =back 192 | 193 | =head1 COPYRIGHT 194 | 195 | Copyright 2011-2016, AMS-IX B.V. 196 | Distributed under GPL and the Artistic License 2.0. 197 | 198 | =cut 199 | 200 | 1; 201 | -------------------------------------------------------------------------------- /sbin/aslogtail.pl: -------------------------------------------------------------------------------- 1 | #!@PERL@ -I../lib 2 | # ============================================================================ 3 | # 4 | # File: aslogtail.pl 5 | # 6 | # Usage: see POD at end 7 | # 8 | # Description: ArpSponge Log Tail 9 | # 10 | # Author: Steven Bakker (SB), 11 | # Created: 2011-03-24 15:38:13 CET 12 | # 13 | # Copyright 2011-2016 AMS-IX B.V.; All rights reserved. 14 | # 15 | # This module is free software; you can redistribute it and/or 16 | # modify it under the same terms as Perl itself. See perldoc perlartistic. 17 | # 18 | # This program is distributed in the hope that it will be useful, 19 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 21 | # 22 | # ============================================================================ 23 | 24 | $0 =~ s|.*/||g; 25 | 26 | use feature ':5.10'; 27 | use strict; 28 | use warnings; 29 | use Getopt::Long qw( GetOptions ); 30 | use Pod::Usage; 31 | use M6::ArpSponge::Control::Client; 32 | use M6::ArpSponge::Util qw( :all ); 33 | 34 | my $SPONGE_VAR = '@SPONGE_VAR@'; 35 | my $CONN = undef; 36 | 37 | # Values set on the Command Line. 38 | my $opt_verbose = undef; 39 | my $rundir = $SPONGE_VAR; 40 | 41 | my $VERSION = '@RELEASE@'; 42 | my $app_header = "\nThis is $0, v$VERSION\n\n" 43 | . "See \"perldoc $0\" for more information.\n" 44 | ; 45 | 46 | sub verbose(@) { print @_ if $opt_verbose; } 47 | 48 | sub Main { 49 | my ($sockname, $raw, $follow, $lines) = initialise(); 50 | 51 | verbose "connecting to arpsponge on $sockname\n"; 52 | my $conn = M6::ArpSponge::Control::Client->create_client($sockname) 53 | or die M6::ArpSponge::Control::Client->error."\n"; 54 | 55 | if ($lines) { 56 | my $reply = $conn->send_command("get_log $lines"); 57 | $reply =~ s/^\[(\S+)\]\s*\Z//m; 58 | dump_log($raw, $reply); 59 | } 60 | if ($follow) { 61 | while ( my @lines = $conn->read_log_data(-blocking => 1) ) { 62 | dump_log($raw, @lines); 63 | } 64 | } 65 | $conn->close; 66 | exit(0); 67 | } 68 | 69 | sub dump_log { 70 | my ($raw, @lines) = @_; 71 | if ($raw) { 72 | print @lines; 73 | } 74 | else { 75 | for my $log (@lines) { 76 | $log =~ s/^(\S+)\t(\d+)\t/format_time($1,' ')." [$2] "/mge; 77 | print $log; 78 | } 79 | } 80 | } 81 | 82 | sub initialise { 83 | my @lines_spec = grep { /^-\d+$/ } @ARGV; 84 | @ARGV = grep { ! /^-\d+$/ } @ARGV; 85 | 86 | my $lines = 10; 87 | if (@lines_spec) { 88 | ($lines) = $lines_spec[$#lines_spec] =~ /^-(\d+)$/; 89 | } 90 | 91 | GetOptions( 92 | 'verbose' => \$opt_verbose, 93 | 'help|?' => 94 | sub { pod2usage(-msg => $app_header, -exitval=>0, -verbose=>0) }, 95 | 'interface=s' => \(my $interface), 96 | 'rundir=s' => \$rundir, 97 | 'socket=s' => \(my $sockname), 98 | 'follow|f' => \(my $follow = 0), 99 | 'lines=i' => \$lines, 100 | 'raw!' => \(my $raw = 0), 101 | 'manual' => sub { pod2usage(-exitval=>0, -verbose=>2) }, 102 | ) or pod2usage(-exitval=>2); 103 | 104 | if ($sockname) { 105 | if ($interface) { 106 | die "$0: --socket and --interface are mutually exclusive\n"; 107 | } 108 | } 109 | elsif ($interface) { 110 | $sockname = "$rundir/$interface/control"; 111 | } 112 | else { 113 | for my $entry (glob("$rundir/*")) { 114 | if (-S "$entry/control") { 115 | $sockname = "$entry/control"; 116 | last; 117 | } 118 | } 119 | if (!$sockname) { 120 | die "$0: cannot find sponge instance in $rundir\n"; 121 | } 122 | 123 | } 124 | 125 | if (@ARGV) { 126 | pod2usage(-msg => "Too many arguments", -exitval=>2); 127 | } 128 | 129 | return ($sockname, $raw, $follow, $lines); 130 | } 131 | 132 | ############################################################################## 133 | 134 | Main(); 135 | 136 | __END__ 137 | 138 | =head1 NAME 139 | 140 | aslogtail - Arp Sponge log tail 141 | 142 | =head1 SYNOPSIS 143 | 144 | B 145 | [B<--verbose>] 146 | [B<--rundir>=I] 147 | [B<--interface>=I] 148 | [B<--socket>=I] 149 | [B<--follow>] 150 | [B<->I | B<--lines>=I] 151 | [B<-->[B]B] 152 | 153 | =head1 DESCRIPTION 154 | 155 | The C program functions like C, but instead of operating 156 | on a file, it connects to a running L's control 157 | socket, reads log events from the daemon and prints them to F. 158 | 159 | By default, the program connects to the first control socket it finds in 160 | F<@SPONGE_VAR@> (see L), but see L below 161 | for ways to override this. 162 | 163 | Like L, it prints 10 lines of log by default and supports 164 | "follow" mode (L<--follow|/--follow>). 165 | 166 | Output is in the form of: 167 | 168 | YYYY-MM-DD hh:mm:ss [pid] message 169 | 170 | E.g.: 171 | 172 | 2011-04-12 16:52:46 [17325] alive=25 dead=37 pending=0 ARP_entries=25 173 | 174 | =head1 OPTIONS 175 | 176 | =over 177 | 178 | =item I<-N>, B<--lines>=I 179 | 180 | Print the last I lines of the log. 181 | 182 | =item B<--follow> 183 | 184 | Stay connected and print each log line as it comes in from the daemon. 185 | 186 | =item B<--interface>=I 187 | 188 | Connect to the L instance for interface I. 189 | 190 | =item X<--raw>X<--noraw>B<--raw>, B<--noraw> 191 | 192 | If C<--raw> is specified, output will be in the form of: 193 | 194 | 195 | 196 | Where I is the seconds since epoch, I is the daemon's process ID 197 | and I is the log message. 198 | 199 | =item B<--rundir>=I 200 | 201 | Override the default top directory for the L control files. 202 | See also L below. 203 | 204 | =item B<--socket>=I 205 | 206 | Explicitly specify the path of the control socket to connect to. Mutually 207 | exclusive with L<--interface|/--interface>. 208 | 209 | =item X<--verbose>B<--verbose> 210 | 211 | The C<--verbose> flag causes the program to be a little more talkative. 212 | 213 | 214 | =back 215 | 216 | =head1 FILES 217 | 218 | =over 219 | 220 | =item F<@SPONGE_VAR@> 221 | 222 | Default top-level directory location for per-interface control sockets: 223 | the L on interface I will have its control socket at 224 | F<@SPONGE_VAR@/>IF. 225 | 226 | =back 227 | 228 | =head1 SEE ALSO 229 | 230 | L, 231 | L, 232 | L, 233 | L. 234 | 235 | =head1 AUTHOR 236 | 237 | Steven Bakker Esteven.bakker@ams-ix.netE. 238 | 239 | =head1 COPYRIGHT 240 | 241 | Copyright 2011-2016, AMS-IX B.V. 242 | Distributed under GPL and the Artistic License 2.0. 243 | 244 | =cut 245 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Control/Base.pm: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # 3 | # ARP sponge control socket, base class. 4 | # 5 | # Copyright 2011-2016 AMS-IX B.V.; All rights reserved. 6 | # 7 | # This module is free software; you can redistribute it and/or 8 | # modify it under the same terms as Perl itself. See perldoc 9 | # perlartistic. 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. 14 | # 15 | # See the "Copying" file that came with this package. 16 | # 17 | # S.Bakker, 2011 18 | # 19 | ############################################################################### 20 | package M6::ArpSponge::Control::Base; 21 | 22 | use strict; 23 | use base qw( IO::Socket::UNIX ); 24 | use M6::ArpSponge::Control; 25 | 26 | use IO::Socket; 27 | 28 | BEGIN { 29 | our $VERSION = '0.03'; 30 | } 31 | 32 | sub error { return M6::ArpSponge::Control->error() }; 33 | 34 | sub _set_error { 35 | my ($self, @args) = @_; 36 | return M6::ArpSponge::Control->_set_error(@args); 37 | } 38 | 39 | # $handle = $handle->_send_data("something\n", ...); 40 | # 41 | # Wrapper around "syswrite" on a socket handle. 42 | # This catches SIGPIPE for when the remote end has disconnected. 43 | # In case of a SIGPIPE or other error, this will return undef, 44 | # otherwise it will return the object itself, allowing chaining: 45 | # 46 | # $handle->_send_data("hello world\n"); 47 | # $handle->_send_data("hello", " world\n"); 48 | # 49 | # $handle->_send_data("hello")->_send_data(" world\n"); 50 | # 51 | sub _send_data { 52 | my ($self, @args) = @_; 53 | my $data = join('', @args); 54 | 55 | local($::SIG{PIPE}) = 'IGNORE'; 56 | 57 | # Temporarily force blocking to avoid socket overflow 58 | # on large data buffers. 59 | my $oldblocking = $self->blocking(1); 60 | 61 | my $nwritten = $self->syswrite($data); 62 | if (!$nwritten && length($!)) { 63 | return $self->_set_error($!); 64 | } 65 | 66 | # Restore blocking. 67 | $self->blocking($oldblocking); 68 | return $self; 69 | } 70 | 71 | # $data = $handle->_get_data($blocking); 72 | # 73 | # Wrapper around "sysread" on a socket handle. This normally 74 | # implements a non-blocking read on a socket, regardless of 75 | # what the current blocking mode on the socket is. Returns 76 | # "undef" if there is no data. Tries to read no more than 77 | # $M6::ArpSponge::Control::BUFSIZ bytes, but may run over that if 78 | # the last character is not a newline. 79 | # 80 | # $data = $handle->_get_data($blocking); 81 | # 82 | sub _get_data { 83 | my ($self, $blocking) = @_; 84 | 85 | $blocking //= 0; 86 | 87 | my $buf; 88 | my $old_blocking = $self->blocking($blocking); 89 | my $n = $self->sysread($buf, $M6::ArpSponge::Control::BUFSIZ); 90 | 91 | if ($buf !~ /\n\Z/) { 92 | my $char; 93 | while ($self->sysread($char, 1)) { 94 | $buf .= $char; 95 | $n++; 96 | last if $char eq "\n"; 97 | } 98 | } 99 | $self->blocking($old_blocking); 100 | return $n ? $buf : undef; 101 | } 102 | 103 | 1; 104 | 105 | __END__ 106 | 107 | =pod 108 | 109 | =head1 NAME 110 | 111 | M6::ArpSponge::Control::Base - base class for arpsponge control communications 112 | 113 | =head1 SYNOPSIS 114 | 115 | package SomeSocket; 116 | 117 | use base qw( M6::ArpSponge::Control::Base ); 118 | 119 | sub do_something { 120 | my $self = shift; 121 | my $arg = "@_"; 122 | 123 | if ($arg !~ /^Simon says, /) { 124 | return $self->_set_error("You forgot the magic prefix"); 125 | } 126 | 127 | $self->_send_data($arg) || return; 128 | return $self->_get_data; 129 | } 130 | 131 | package main; 132 | 133 | my $thing = SomeSocket->new( 134 | Peer => $socket_file, 135 | Type => SOCK_STREAM, 136 | ); 137 | 138 | if (my $result = $self->do_something(@ARGV)) { 139 | print "OK: $result\n"; 140 | } 141 | else { 142 | print STDERR "** ERROR: ", $thing->error, "\n"; 143 | } 144 | 145 | =head1 DESCRIPTION 146 | 147 | This module implements the basis of a simple client/server 148 | protocol for controlling the ARP sponge using (UNIX domain) 149 | sockets. 150 | 151 | This object class is only supposed to be used as a base class 152 | from which other (usable) classes are derived, see 153 | L 154 | and 155 | L. 156 | 157 | It is a fairly thin wrapper around L(3p), 158 | implementing some defaults and handling exceptions (most 159 | notably the SIGPIPE when writing to a disconnected peer). 160 | 161 | =head1 CONSTRUCTORS 162 | 163 | This object defines no constructors of its own, i.e. it 164 | inherits from L(3). 165 | 166 | =head1 METHODS 167 | 168 | =over 169 | 170 | =item XB 171 | 172 | Callable as an object or class method. Returns the most recent 173 | error string. 174 | 175 | Wrapper around L. 176 | 177 | =item X<_set_error>B<_set_error> ( I, ... ) 178 | 179 | Set the class' last error message. Always returns undef/empty list, so 180 | it can be used efficiently as: 181 | 182 | if ($some_error) { 183 | return $self->_set_error("something bad happened: $!"); 184 | } 185 | 186 | Wrapper around L. 187 | 188 | =item X<_send_data>B<_send_data> ( I, ... ) 189 | 190 | Wrapper around C, writing I to the remote end. 191 | This catches SIGPIPE for when the remote end has disconnected. 192 | In case of a SIGPIPE or other error, this will return undef, 193 | otherwise it will return the object itself, allowing chaining. 194 | 195 | Equivalent: 196 | 197 | $handle->_send_data("hello world\n"); 198 | $handle->_send_data("hello", " world\n"); 199 | 200 | All arguments are concatenated and the result is sent to the remote end. 201 | 202 | Slightly less efficient: 203 | 204 | $handle->_send_data("hello")->_send_data(" world\n"); 205 | 206 | This may cause your program to die if the first _send_data() fails. 207 | 208 | =item X<_get_data>B<_get_data> ( I ) 209 | 210 | Wrapper around C on a socket handle. This normally 211 | implements a non-blocking read on a socket, regardless of 212 | the current blocking mode on the sockets. Returns 213 | C if there is no data (or an error occurs). 214 | 215 | Specify a true value for the I parameter 216 | if you want the call to block for input. 217 | 218 | In case there is data, it will read all the available data up to 219 | L<$M6::ArpSponge::Control::BUFSIZ|M6::ArpSponge::Control/$M6::ArpSponge:Control::BUFSIZ> 220 | bytes. 221 | 222 | Tries to read no more than I characters, but may run over that 223 | until it encounters a newline. 224 | 225 | =back 226 | 227 | =head1 EXAMPLE 228 | 229 | See the L section. 230 | 231 | =head1 SEE ALSO 232 | 233 | L(3), 234 | L(3), 235 | L(3), 236 | L(3). 237 | L(8). 238 | 239 | =head1 AUTHORS 240 | 241 | Steven Bakker at AMS-IX (steven.bakker@ams-ix.net). 242 | 243 | =head1 COPYRIGHT 244 | 245 | Copyright 2011-2016, AMS-IX B.V. 246 | Distributed under GPL and the Artistic License 2.0. 247 | 248 | =cut 249 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Event.pm: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | ############################################################################### 3 | # 4 | # Logging for the ARP Sponge. 5 | # 6 | # Copyright 2014-2016 AMS-IX B.V.; All rights reserved. 7 | # 8 | # This module is free software; you can redistribute it and/or 9 | # modify it under the same terms as Perl itself. See perldoc 10 | # perlartistic. 11 | # 12 | # This program is distributed in the hope that it will be useful, 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 15 | # 16 | # See the "Copying" file that came with this package. 17 | # 18 | # S.Bakker, 2014; 19 | # 20 | ############################################################################### 21 | package M6::ArpSponge::Event; 22 | 23 | use strict; 24 | 25 | use parent qw( Exporter ); 26 | 27 | use M6::ArpSponge::Log qw( :standard :macros ); 28 | 29 | BEGIN { 30 | our $VERSION = 1.00; 31 | 32 | our @func = (qw( 33 | event_log 34 | event_mask 35 | event_mask_split 36 | event_mask_to_str 37 | event_names event_values 38 | is_event_mask 39 | is_valid_event_mask 40 | parse_event_mask 41 | ), 42 | map { "event_$_" } 43 | qw( emerg alert crit err warning notice info debug ) 44 | ); 45 | 46 | our @macros = qw( 47 | EVENT_IO 48 | EVENT_ALIEN 49 | EVENT_SPOOF 50 | EVENT_STATIC 51 | EVENT_SPONGE 52 | EVENT_CTL 53 | EVENT_STATE 54 | EVENT_ALL 55 | EVENT_NONE 56 | ); 57 | 58 | our %EXPORT_TAGS = ( 59 | 'standard' => [ @func, @macros ], 60 | 'macros' => \@macros, 61 | 'func' => \@func, 62 | 'all' => [ @func, @macros ], 63 | ); 64 | our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} }; 65 | our @EXPORT = @{ $EXPORT_TAGS{'standard'} }; 66 | } 67 | 68 | ############################################################################# 69 | use constant { 70 | EVENT_IO => 0x0001, 71 | EVENT_ALIEN => 0x0002, 72 | EVENT_SPOOF => 0x0004, 73 | EVENT_STATIC => 0x0008, 74 | EVENT_SPONGE => 0x0010, 75 | EVENT_CTL => 0x0020, 76 | EVENT_STATE => 0x0040, 77 | EVENT_ALL => 0xffff, 78 | EVENT_NONE => 0x0000, 79 | }; 80 | 81 | our %EVENT_MASK_TO_STR = ( 82 | EVENT_IO() => 'io', 83 | EVENT_ALIEN() => 'alien', 84 | EVENT_SPOOF() => 'spoof', 85 | EVENT_STATIC() => 'static', 86 | EVENT_SPONGE() => 'sponge', 87 | EVENT_CTL() => 'ctl', 88 | EVENT_STATE() => 'state', 89 | ); 90 | 91 | our %STR_TO_EVENT_MASK = ( 92 | reverse(%EVENT_MASK_TO_STR), 93 | 'all' => EVENT_ALL(), 94 | 'none' => EVENT_NONE(), 95 | ); 96 | 97 | our $Default_Mask = EVENT_ALL(); 98 | 99 | ############################################################################# 100 | 101 | my $Event_Mask = EVENT_ALL(); 102 | 103 | sub __event_getset { 104 | my $ref = $_[0]; 105 | if (@_ > 1) { 106 | my $old = $$ref; 107 | $$ref = $_[1]; 108 | return $old; 109 | } 110 | return $$ref; 111 | } 112 | 113 | sub event_names { return sort keys %STR_TO_EVENT_MASK } 114 | sub event_values { return sort keys %EVENT_MASK_TO_STR } 115 | 116 | sub event_mask { return __event_getset(\$Event_Mask, @_) } 117 | sub is_event_mask { return ($_[0] & $Event_Mask) != 0 } 118 | 119 | sub event_emerg { event_log(LOG_EMERG, $_[0], @_[1..$#_]) } 120 | sub event_alert { event_log(LOG_ALERT, $_[0], @_[1..$#_]) } 121 | sub event_crit { event_log(LOG_CRIT, $_[0], @_[1..$#_]) } 122 | sub event_err { event_log(LOG_ERR, $_[0], @_[1..$#_]) } 123 | sub event_warning { event_log(LOG_WARNING, $_[0], @_[1..$#_]) } 124 | sub event_notice { event_log(LOG_NOTICE, $_[0], @_[1..$#_]) } 125 | sub event_info { event_log(LOG_INFO, $_[0], @_[1..$#_]) } 126 | sub event_debug { event_log(LOG_DEBUG, $_[0], @_[1..$#_]) } 127 | 128 | =item B ( I, I, I [, I, ... ] ) 129 | X 130 | 131 | Log an I at level I, with the message specified by 132 | the I format string and any additional arguments. 133 | 134 | If I matches the current event mask and I passes 135 | the current log level threshold, the message is logged (L), 136 | otherwise it is discarded. 137 | 138 | =cut 139 | 140 | sub event_log($$@) { 141 | my ($level, $event, @args) = @_; 142 | 143 | if ( ($event & $Event_Mask) and ($level <= log_level()) ) { 144 | print_log_level($level, @args); 145 | } 146 | } 147 | 148 | =item B ( I [, B<-err> =E I] ) 149 | X 150 | 151 | Check whether the I represents a valid log event. 152 | 153 | If an error occurs, and C<-err> is specified, the scalar behind I will 154 | contain a diagnostic. 155 | 156 | =cut 157 | 158 | sub is_valid_event_mask { 159 | my ($arg) = @_; 160 | my $err_s; 161 | my %opts = (-err => \$err_s, @_[1..$#_]); 162 | 163 | if (defined (my $level = $STR_TO_EVENT_MASK{lc $arg}) ) { 164 | return $level; 165 | } 166 | 167 | ${$opts{-err}} = q/"$arg" is not a valid event mask/; 168 | return; 169 | } 170 | 171 | =item XB ( I ) 172 | 173 | Return an array of the individual event mask values that make 174 | up the compound I. 175 | 176 | @list = event_mask_split($mask); 177 | print map { event_mask_to_str($_)."\n" } @list; 178 | 179 | =cut 180 | 181 | sub event_mask_split { 182 | my $mask = int($_[0]); 183 | return sort grep { $_ & $mask } keys %EVENT_MASK_TO_STR; 184 | } 185 | 186 | =item B 187 | ( I [, B<-err> =E I] ) 188 | X 189 | 190 | Check whether I represents a valid list of event masks. Returns an 191 | integer representing the mask on success, C on error. Note that an 192 | undefined I is still valid, and represents the current mask. 193 | 194 | If an error occurs, and C<-err> is specified, the scalar behind I will 195 | contain a diagnostic. 196 | 197 | =cut 198 | 199 | sub parse_event_mask { 200 | my $arg = $_[0]; 201 | my $err_s; 202 | my %opts = (-err => \$err_s, @_[1..$#_]); 203 | 204 | return event_mask() if ! defined $arg; 205 | my $mask; 206 | for my $event (split(/\s*,\s*/, lc $arg)) { 207 | my $negate = 0; 208 | my $cumulative = 0; 209 | 210 | my $first_char = substr($event, 0, 1); 211 | if ($first_char eq '!') { 212 | substr($event, 0, 1) = ''; 213 | $negate = 1; 214 | $mask //= event_mask(); 215 | } 216 | elsif ($first_char eq '+') { 217 | substr($event, 0, 1) = ''; 218 | $mask //= event_mask(); 219 | } 220 | else { 221 | $mask //= EVENT_NONE; 222 | } 223 | 224 | if ($event eq 'none') { 225 | $event = 'all'; 226 | $negate = !$negate; 227 | } 228 | 229 | if (!exists $STR_TO_EVENT_MASK{$event}) { 230 | ${$opts{-err}} = qq/"$event" is not a valid event name/; 231 | return; 232 | } 233 | 234 | if ($negate) { 235 | $mask &= ~ int($STR_TO_EVENT_MASK{$event}); 236 | next; 237 | } 238 | $mask |= $STR_TO_EVENT_MASK{$event}; 239 | } 240 | return $mask; 241 | } 242 | 243 | =item B ( I ) 244 | X 245 | 246 | Translate the bits in I to event mask names and return a list of 247 | them. 248 | 249 | =cut 250 | 251 | sub event_mask_to_str { 252 | my ($mask) = @_; 253 | 254 | return if !$mask; 255 | 256 | return map { $EVENT_MASK_TO_STR{$_} } event_mask_split($mask); 257 | } 258 | 259 | =head1 COPYRIGHT 260 | 261 | Copyright 2014-2016, AMS-IX B.V. 262 | Distributed under GPL and the Artistic License 2.0. 263 | 264 | =cut 265 | 266 | 1; 267 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Control/Client.pm: -------------------------------------------------------------------------------- 1 | ############################################################################# 2 | ############################################################################## 3 | # 4 | # ARP sponge control socket. 5 | # 6 | # Copyright 2011-2016 AMS-IX B.V.; All rights reserved. 7 | # 8 | # This module is free software; you can redistribute it and/or 9 | # modify it under the same terms as Perl itself. See perldoc 10 | # perlartistic. 11 | # 12 | # This program is distributed in the hope that it will be useful, 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 15 | # 16 | # See the "Copying" file that came with this package. 17 | # 18 | # S.Bakker, 2011 19 | # 20 | ############################################################################### 21 | package M6::ArpSponge::Control::Client; 22 | 23 | use strict; 24 | 25 | use base qw( M6::ArpSponge::Control::Base ); 26 | 27 | use IO::Socket; 28 | 29 | use M6::ArpSponge::Control; 30 | 31 | # $ref = $handle->_log_buffer; 32 | # $handle->_log_buffer($ref); 33 | # 34 | # Get/set the internal buffer of logging lines received from 35 | # the server end. The log_buffer acts as a circular buffer of 36 | # $MAXLOGLINES lines. 37 | # 38 | sub _log_buffer { 39 | my $self = $_[0]; 40 | if (@_ > 1) { 41 | ${*$self}{'m6_arp_control_client_log_buffer'} = $_[1]; 42 | return $self; 43 | } 44 | return ${*$self}{'m6_arp_control_client_log_buffer'}; 45 | } 46 | 47 | # $leftover = $handle->_parse_log_buffer($data [, \@logbuffer]); 48 | # 49 | # Remove the "\014LOG\t" log lines from $data, store them in the 50 | # internal log buffer (or @logbuffer if given) and return the rest 51 | # of $data. 52 | # 53 | sub _parse_log_buffer { 54 | my ($self, $data, $log) = @_; 55 | 56 | my $maxloglines = 0; 57 | if (!$log) { 58 | $log = $self->_log_buffer; 59 | $maxloglines = $M6::ArpSponge::Control::MAXLOGLINES; 60 | } 61 | 62 | while ($data =~ s/^\014LOG\t(.*?\n)//m) { 63 | if ($maxloglines && @$log > $maxloglines) { 64 | shift @$log; # Rotate log buffer if necessary. 65 | } 66 | push @$log, $1; 67 | } 68 | return $data; 69 | } 70 | 71 | 72 | # $data = $handle->get_log_buffer; 73 | # 74 | # Return the internal log buffer as a single string. Gather 75 | # any other log information you can get if it is available. 76 | # 77 | sub get_log_buffer { 78 | my ($self, @args) = @_; 79 | my %args = (-order => +1, @args); 80 | 81 | # Tease out log data from the socket. 82 | my $buf = $self->_parse_log_buffer($self->_get_data(0)); 83 | 84 | # Anything else is weird. Tag it as such. 85 | if (length $buf) { 86 | $buf =~ s/^/UNEXPECTED: /gm; 87 | } 88 | 89 | my $log = $self->_log_buffer; 90 | 91 | $buf = $buf . join('', $args{-order} < 0 ? reverse @$log : @$log); 92 | 93 | return length $buf ? $buf : undef; 94 | } 95 | 96 | # $handle->clear_log_buffer; 97 | # 98 | # Clear the internal log buffer. 99 | # 100 | sub clear_log_buffer { 101 | @{$_[0]->_log_buffer} = (); 102 | return $_[0]; 103 | } 104 | 105 | 106 | # @lines = $handle->read_log_data( [ -blocking => {0|1} ] ); 107 | # 108 | # Read logging data from $handle. Default is to block for input, 109 | # but can be overridden with "-blocking => 0". 110 | # 111 | sub read_log_data { 112 | my ($self, @args) = @_; 113 | my %args = (-blocking => 1, @args); 114 | 115 | my @lines; 116 | 117 | # Tease out log data from the socket. 118 | my $buf = $self->_parse_log_buffer($self->_get_data($args{-blocking}), \@lines); 119 | 120 | # Anything else is weird. Tag it as such. 121 | if (length $buf) { 122 | push @lines, map { "UNEXPECTED: $_\n" } split(/\n/, $buf); 123 | } 124 | return @lines; 125 | } 126 | 127 | # $data = $handle->_get_response; 128 | # 129 | # Wrapper around "sysread" on a socket handle, reads data 130 | # until it sees the "ready" prompt or an EOF. Strips the 131 | # ready prompt. 132 | # 133 | # Returns undef on EOF or error, a string with the response 134 | # otherwise. Note that the response string may be empty. 135 | # 136 | sub _get_response { 137 | my ($self) = @_; 138 | my $response = ''; 139 | my $buf = ''; 140 | my $ok = undef; 141 | 142 | while (my $buf = $self->_get_data(1)) { 143 | $response .= $buf; 144 | if ($response =~ s/^\014READY\n//m) { 145 | $ok = 1; 146 | last; 147 | } 148 | } 149 | #print STDERR "BUFFER:<$response>\n"; 150 | $response = $self->_parse_log_buffer($response); 151 | return $ok ? $response : undef; 152 | } 153 | 154 | sub create_client { 155 | my ($type, $sockfile) = @_; 156 | my $self = $type->new( 157 | Peer => $sockfile, 158 | Type => SOCK_STREAM, 159 | ) or return; 160 | 161 | return bless $self, $type; 162 | } 163 | 164 | sub new { 165 | my ($type, @args) = @_; 166 | my $self = $type->SUPER::new(@args) or return $type->_set_error($!); 167 | 168 | bless $self, $type; 169 | $self->_log_buffer([]); 170 | if (defined $self->_get_response) { 171 | return $self; 172 | } 173 | print STDERR "__PACKAGE__ new: _get_response returned undef\n"; 174 | return; 175 | } 176 | 177 | # $reply = $handle->send_command($command); 178 | # 179 | # Send $command to the remote end and wait for the answer. 180 | # Returns the answer (minus any LOG lines). Returns undef 181 | # on error, in which case the connection is considered to 182 | # be lost. 183 | # 184 | sub send_command { 185 | my ($self, @args) = @_; 186 | my $command = join(' ', split(' ', join('', @args)))."\n"; 187 | 188 | $self->_send_data($command) || return; 189 | return $self->_get_response; 190 | } 191 | 192 | 1; 193 | 194 | __END__ 195 | 196 | =pod 197 | 198 | =head1 NAME 199 | 200 | M6::ArpSponge::Control::Client - client part of arpsponge control 201 | 202 | =head1 SYNOPSIS 203 | 204 | use M6::ArpSponge::Control::Client; 205 | 206 | $client = M6::ArpSponge::Control::Client->create_client($socket_file); 207 | 208 | # Alternative method (equivalent to above): 209 | use IO::Socket; 210 | $client = M6::ArpSponge::Control::Client->new( 211 | Peer => $socket_file, 212 | Type => SOCK_STREAM, 213 | ); 214 | 215 | $reply = $client->send_command('something important'); 216 | 217 | if (!defined $reply) { 218 | if ($err = $client->error) { 219 | print STDERR "Error: $err\n"; 220 | } 221 | print STDERR "Server disconnected\n"; 222 | $client->close; 223 | } 224 | 225 | =head1 DESCRIPTION 226 | 227 | This module implements the client side of the 228 | L(8) 229 | control connection. 230 | 231 | =head1 CONSTRUCTORS 232 | 233 | =over 234 | 235 | =item XB ( I<%ARGS> ) 236 | 237 | Create a new object instance and return a reference to it. Because 238 | this object inherits from L(3), we must keep the same 239 | semantics for the arguments. 240 | 241 | The L method is preferred. 242 | 243 | =item XB ( I ) 244 | 245 | Create a new client instance, connecting to I and return 246 | a reference to the client object. 247 | 248 | On error, returns C and sets the module's error field. 249 | 250 | =back 251 | 252 | =head1 METHODS 253 | 254 | =over 255 | 256 | =back 257 | 258 | =head1 EXAMPLE 259 | 260 | See the L section. 261 | 262 | =head1 SEE ALSO 263 | 264 | L(3), 265 | L(3), 266 | L(3), 267 | L(3), 268 | L(3), 269 | L(8), L(1). 270 | 271 | =head1 AUTHORS 272 | 273 | Steven Bakker at AMS-IX (steven.bakker@ams-ix.net). 274 | 275 | =head1 COPYRIGHT 276 | 277 | Copyright 2011-2016, AMS-IX B.V. 278 | Distributed under GPL and the Artistic License 2.0. 279 | 280 | =cut 281 | -------------------------------------------------------------------------------- /rules.mk: -------------------------------------------------------------------------------- 1 | # 2 | #!make 3 | # Copyright 2005-2016 AMS-IX B.V.; All rights reserved. 4 | # 5 | # This module is free software; you can redistribute it and/or 6 | # modify it under the same terms as Perl itself. See perldoc 7 | # perlartistic. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 12 | # 13 | # See the "Copying" file that came with this package. 14 | 15 | default : all 16 | 17 | RM = /bin/rm -f 18 | MV = /bin/mv 19 | 20 | RELEASE := $(shell head -1 $(TOPDIR)/Changelog | perl -p -e 's/.*\((.*?)\).*/$$1/') 21 | NAME = arpsponge 22 | PACKAGE = $(NAME)-$(RELEASE) 23 | TOOLDIR = $(TOPDIR)/tools 24 | 25 | INSTALL_LOG = $(TOPDIR)/installed.log 26 | INSTALLPROG = $(TOOLDIR)/bsdinst -c -l $(INSTALL_LOG) 27 | INSTALL = $(INSTALLPROG) -o $(OWNER) -g $(GROUP) -m $(MODE) 28 | BININSTALL = $(INSTALLPROG) -o $(OWNER) -g $(GROUP) -m $(BINMODE) 29 | 30 | MKDIR = $(TOOLDIR)/mkinstalldirs 31 | RMDIR = $(TOOLDIR)/rminstalldirs 32 | 33 | # 34 | # Substitute configuration variables in files. 35 | # 36 | perlit= $(PERL) -p -e \ 37 | "s!\@LIBDIR@!$(LIBDIR)!g; \ 38 | s!\@BINDIR@!$(BINDIR)!g; \ 39 | s!\@DFL_PATH@!$(DFL_PATH)!g; \ 40 | \ 41 | s!\@NAME@!$(NAME)!g; \ 42 | s!\@UNAME@!\U$(NAME)\E!g; \ 43 | s!\@Uname@!\u$(NAME)!g; \ 44 | \ 45 | s!\@OWNER@!$(OWNER)!g; \ 46 | s!\@GROUP@!$(GROUP)!g; \ 47 | \ 48 | s!\@SECTION@!\U$(SECTION)\E!g; \ 49 | s!\@USECTION@!\U$(SECTION)\E!g; \ 50 | s!\@FILESECTION@!$(FILESECTION)!g; \ 51 | s!\@UFILESECTION@!\U$(FILESECTION)\E!g; \ 52 | \ 53 | s!\@RELEASE@!$(RELEASE)!g; \ 54 | s!\@SHELL@!$(SHELL)!g; \ 55 | s!\@PERL@!$(PERL)!g; \ 56 | \ 57 | s!\@SPONGE_VAR@!$(SPONGE_VAR)!g; \ 58 | s!\@DFL_SOCK_PERMS@!$(DFL_SOCK_PERMS)!g; \ 59 | \ 60 | s!\@IFCONFIG@!$(IFCONFIG)!g; \ 61 | s!\@DFL_RATE@!$(DFL_RATE)!g; \ 62 | s!\@DFL_INIT@!$(DFL_INIT)!g; \ 63 | s!\@DFL_ARP_AGE@!$(DFL_ARP_AGE)!g; \ 64 | s!\@DFL_QUEUEDEPTH@!$(DFL_QUEUEDEPTH)!g; \ 65 | s!\@DFL_FLOOD_PROTECTION@!$(DFL_FLOOD_PROTECTION)!g; \ 66 | s!\@DFL_PENDING@!$(DFL_PENDING)!g; \ 67 | s!\@DFL_PROBERATE@!$(DFL_PROBERATE)!g; \ 68 | s!\@DFL_LEARN@!$(DFL_LEARN)!g; \ 69 | s!\@DFL_LOGLEVEL@!$(DFL_LOGLEVEL)!g; \ 70 | \ 71 | s!\@ETC_DEFAULT@!$(ETC_DEFAULT)!g; \ 72 | " 73 | 74 | .SUFFIXES: .al .pm .pmrsc .pl \ 75 | .src \ 76 | .sample \ 77 | .sh \ 78 | .txt .ps \ 79 | .$(SECTION) .pod .man .txt 80 | 81 | version: 82 | @echo $(RELEASE) 83 | 84 | % : %.sh Makefile 85 | @echo building $@ from $< 86 | @$(perlit) $< > $@ 87 | @chmod 755 $@ 88 | 89 | %.sample : %.sample.src Makefile 90 | @echo building $@ from $< 91 | @$(perlit) $< > $@ 92 | @chmod 644 $@ 93 | 94 | % : %.src Makefile 95 | @echo building $@ from $< 96 | @$(perlit) $< > $@ 97 | @chmod 644 $@ 98 | 99 | % : %.pl Makefile 100 | @ echo building $@ from $< 101 | @ $(perlit) $< > $@ 102 | @ chmod 755 $@ 103 | @ $(PERL) -wc $@ || $(RM) $@ 104 | 105 | %.$(SECTION) : %.pod 106 | @echo building $@ from $< 107 | @PERLLIB=$$PERLLIB:$(TOPDIR)/lib; export PERLLIB; \ 108 | pod2man \ 109 | --release="$(NAME)-$(RELEASE)" \ 110 | --date="`date`" \ 111 | --center="AMS-IX Management Utilities" \ 112 | --section=$(SECTION) \ 113 | --name="`echo $* | sed -e 's/\.\./::/g'`" \ 114 | $< > $@ 115 | 116 | %.html : %.pod 117 | @echo building $@ from $< 118 | @PERLLIB=$$PERLLIB:$(TOPDIR)/lib; export PERLLIB; \ 119 | $(TOOLDIR)/pod2html \ 120 | --name="`echo $* | sed -e 's/\.\./::/g'`" \ 121 | $< > $@ 122 | 123 | %.txt : %.$(SECTION) 124 | @echo building $@ from $< 125 | @$(perlit) $< | nroff -Tascii -man > $@ 126 | 127 | %.ps : %.$(SECTION) 128 | @echo building $@ from $< 129 | @$(perlit) $< | groff -Tps -man > $@ 130 | 131 | $(INITDIR)/% : % 132 | @echo installing executable $< in $(INITDIR) 133 | $(MKDIR) $(INITDIR) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 134 | $(BININSTALL) $< $@ 135 | $(PERL) -pi -e 's|^(#!/.*) -I../lib|$$1|' $@ 136 | 137 | $(BINDIR)/% : % 138 | @echo installing executable $< in $(BINDIR) 139 | $(MKDIR) $(BINDIR) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 140 | $(BININSTALL) $< $@ 141 | $(PERL) -pi -e 's|^(#!/.*) -I../lib|$$1|' $@ 142 | 143 | $(MANDIR)/man$(SECTION)/% : % 144 | @echo installing $< in $(MANDIR)/man$(SECTION) 145 | @$(MKDIR) $(MANDIR)/man$(SECTION) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 146 | @$(INSTALL) $< $@ 147 | 148 | $(DOCDIR)/% : % 149 | @if [ ! -n "$(SKIPDOCS)" ]; then \ 150 | echo installing $< in $(DOCDIR); \ 151 | $(MKDIR) $(DOCDIR) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG); \ 152 | $(INSTALL) $< $@; \ 153 | fi 154 | 155 | $(INSTDIR1)/% : % 156 | @echo installing $< in $(INSTDIR1) 157 | @$(MKDIR) $(INSTDIR1) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 158 | @$(INSTALL) $< $@ 159 | 160 | $(INSTDIR2)/% : % 161 | @echo installing $< in $(INSTDIR2) 162 | @$(MKDIR) $(INSTDIR2) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 163 | @$(INSTALL) $< $@ 164 | 165 | $(INSTDIR3)/% : % 166 | @echo installing $< in $(INSTDIR3) 167 | @$(MKDIR) $(INSTDIR3) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 168 | @$(INSTALL) $< $@ 169 | 170 | $(INSTALLDIR)/% : % 171 | @echo installing $< in $(INSTALLDIR) 172 | @$(MKDIR) $(INSTALLDIR) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 173 | @$(INSTALL) $< $@ 174 | 175 | %.sample : % 176 | @echo building $@ from $< 177 | @$(perlit) $< > $@ 178 | @chmod 644 $@ 179 | 180 | auto/$(AUTO)/%/autosplit.ix : $(AUTO)/%.pm 181 | @echo autosplit $<; 182 | @PERLLIB=$$PERLLIB:$(TOPDIR)/lib; export PERLLIB; \ 183 | $(TOOLDIR)/autosplit ./auto $< 184 | 185 | auto/$(AUTO1)/%/autosplit.ix : $(AUTO1)/%.pm 186 | @echo autosplit $<; 187 | @PERLLIB=$$PERLLIB:$(TOPDIR)/lib; export PERLLIB; \ 188 | $(TOOLDIR)/autosplit ./auto $< 189 | 190 | %-all : ; cd $* ; $(MAKE) DISTRO=${DISTRO} all 191 | %-install : ; cd $* ; $(MAKE) DISTRO=${DISTRO} install 192 | %-uninstall : ; cd $* ; $(MAKE) DISTRO=${DISTRO} uninstall 193 | %-autosplit : ; cd $* ; $(MAKE) DISTRO=${DISTRO} autosplit 194 | %-clean : ; cd $* ; $(MAKE) DISTRO=${DISTRO} clean 195 | 196 | all : $(TARGETS) 197 | 198 | install : all installdirs $(INSTALLFILES) install-links post-install 199 | 200 | installdirs : 201 | @echo "Checking/creating installation directories..." 202 | @echo $(INSTALLDIRS) 203 | @$(MKDIR) $(INSTALLDIRS) 2>&1 | sed -e 's/^mkdir //' >> $(INSTALL_LOG) 204 | 205 | post-install : 206 | @$(RM) $(INSTALL_LOG).tmp; \ 207 | sort -ru $(INSTALL_LOG) > $(INSTALL_LOG).tmp; \ 208 | $(MV) $(INSTALL_LOG).tmp $(INSTALL_LOG) 209 | 210 | uninstall : 211 | echo "Removing installed files:" ; \ 212 | files=$(INSTALLFILES); \ 213 | if [ -f $(INSTALL_LOG) ]; then \ 214 | files="$$files `cat $(INSTALL_LOG)`"; \ 215 | fi; \ 216 | echo '** Warning: will remove the following files:'; \ 217 | echo $$files | $(PERL) -n -e \ 218 | 'print map { qq{ $$_\n} } split(" ", $$_);'; \ 219 | if [ `echo "\c" | wc -c` -gt 0 ]; then \ 220 | echo -n "Are you sure [yn] y"; \ 221 | else \ 222 | echo "Are you sure [ny] n\c"; \ 223 | fi; \ 224 | read ans; \ 225 | case "$$ans" in \ 226 | y*|Y*) echo "Removing ..."; \ 227 | $(RM) $$files >/dev/null 2>&1; \ 228 | $(RMDIR) $$files >/dev/null 2>&1; \ 229 | $(RM) $(INSTALL_LOG); \ 230 | echo "Done"; \ 231 | true;; \ 232 | *) false;; \ 233 | esac 234 | 235 | x-uninstall : ; $(RM) $(INSTALLFILES) 236 | 237 | clean : ; @echo cleaning up 238 | @$(RM) $(TARGETS) core 2>/dev/null \ 239 | $(NAME)_*.deb; \ 240 | true 241 | 242 | install-links: 243 | @for link in ._no $(INSTALLLINKS) $(INSTALLINKS); do \ 244 | [ $$link = ._no ] && continue; \ 245 | linkname=`echo $$link | cut -f1 -d:`; \ 246 | fname=`echo $$link | cut -f2 -d:`; \ 247 | if [ ! -f $$linkname ] || [ -h $$linkname ]; then \ 248 | target=`/bin/ls -l $$linkname 2>/dev/null | sed -e 's|^.*-> ||'`; \ 249 | if [ X$$target != X$$fname ]; then \ 250 | $(RM) $$linkname; \ 251 | ln -s $$fname $$linkname; \ 252 | echo $$linkname; \ 253 | fi; \ 254 | fi; \ 255 | done 256 | 257 | veryclean : clean 258 | @if [ -d ./SCCS ]; then sccs clean; fi 259 | 260 | _debtemp := /tmp/deb.$(NAME).$(shell echo $$RANDOM) 261 | 262 | dpkg: 263 | mkdir -p $(_debtemp) 264 | cp -rp . $(_debtemp)/$(NAME)-$(RELEASE) 265 | cd $(_debtemp)/$(NAME)-$(RELEASE); \ 266 | (fakeroot dpkg-buildpackage -b -uc -us || true) 267 | ls $(_debtemp)/$(NAME)_*.deb >/dev/null 2>&1; \ 268 | [ $$? = 0 ] && mv $(_debtemp)/$(NAME)_*.deb . 269 | $(RM) -rf $(_debtemp) 270 | 271 | # 272 | # %: define.h %.c 273 | # $@: target (wonkie) 274 | # $^: dependencies (define.h wonkie.c) 275 | # $<: primary source file (define.h) 276 | # $?: out of date dependency (wonkie.c) 277 | # $*: portion that matched the "%" (wonkie) 278 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Log.pm: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | ############################################################################### 3 | # 4 | # Logging for the ARP Sponge. 5 | # 6 | # Copyright 2011-2016 AMS-IX B.V.; All rights reserved. 7 | # 8 | # This module is free software; you can redistribute it and/or 9 | # modify it under the same terms as Perl itself. See perldoc 10 | # perlartistic. 11 | # 12 | # This program is distributed in the hope that it will be useful, 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 15 | # 16 | # See the "Copying" file that came with this package. 17 | # 18 | # S.Bakker, 2011; 19 | # 20 | ############################################################################### 21 | package M6::ArpSponge::Log; 22 | 23 | use strict; 24 | 25 | use base qw( Exporter ); 26 | 27 | use POSIX qw( strftime ); 28 | use Sys::Syslog qw( :standard :macros ); 29 | 30 | BEGIN { 31 | our $VERSION = 1.00; 32 | 33 | our @func = qw( 34 | init_log 35 | print_log 36 | print_log_level 37 | log_emerg 38 | log_alert 39 | log_crit 40 | log_err 41 | log_warning 42 | log_notice 43 | log_info 44 | log_fatal 45 | log_debug 46 | log_is_verbose log_verbose log_sverbose 47 | log_level is_log_level 48 | is_valid_log_level log_level_to_string 49 | add_notify remove_notify print_notify 50 | get_log_buffer clear_log_buffer log_buffer_size 51 | ); 52 | 53 | our @macros = qw( 54 | LOG_EMERG LOG_ALERT LOG_CRIT LOG_ERR 55 | LOG_WARNING LOG_NOTICE LOG_INFO LOG_DEBUG 56 | ); 57 | 58 | our @vars = qw( 59 | $FACILITY 60 | $LOGOPT 61 | $Debug 62 | $Verbose 63 | ); 64 | 65 | our %EXPORT_TAGS = ( 66 | 'standard' => \@func, 67 | 'macros' => \@macros, 68 | 'vars' => \@vars, 69 | 'func' => \@func, 70 | 'all' => [ @func, @macros, @vars ], 71 | ); 72 | our @EXPORT_OK = @{ $EXPORT_TAGS{'all'} }; 73 | our @EXPORT = @{ $EXPORT_TAGS{'standard'} }; 74 | } 75 | 76 | our $FACILITY = 'user'; 77 | our $LOGOPT = 'pid'; 78 | 79 | ############################################################################# 80 | our $Debug = 0; 81 | our $Verbose = 0; 82 | our $Syslog_Ident = $0; 83 | 84 | ############################################################################# 85 | our $Default_Level = LOG_NOTICE; 86 | 87 | our %STR_TO_LOGLEVEL = ( 88 | 'emerg' => LOG_EMERG, 89 | 'alert' => LOG_ALERT, 90 | 'crit' => LOG_CRIT, 91 | 'err' => LOG_ERR, 92 | 'warning' => LOG_WARNING, 93 | 'notice' => LOG_NOTICE, 94 | 'info' => LOG_INFO, 95 | 'debug' => LOG_DEBUG, 96 | ); 97 | 98 | our %LOGLEVEL_TO_STR = reverse %STR_TO_LOGLEVEL; 99 | 100 | ############################################################################# 101 | 102 | my $Log_Level = LOG_NOTICE; 103 | my @Log_Buffer = (); 104 | my $Log_Buffer_Size = 256; 105 | my $Notify; 106 | 107 | END { 108 | closelog; 109 | } 110 | 111 | sub __log_getset { 112 | my $ref = $_[0]; 113 | return $$ref if @_ == 1; 114 | my $old = $$ref; 115 | $$ref = $_[1]; 116 | return $old; 117 | } 118 | 119 | sub init_log { 120 | $Syslog_Ident = @_ ? $_[0] : $0; 121 | $Syslog_Ident =~ s|.*/||; 122 | openlog($Syslog_Ident, $LOGOPT, $FACILITY); 123 | $Notify = IO::Select->new(); 124 | return 1; 125 | } 126 | 127 | sub log_buffer_size { return __log_getset(\$Log_Buffer_Size, @_) } 128 | sub log_is_verbose { return __log_getset(\$Verbose, @_) } 129 | sub log_level { return __log_getset(\$Log_Level, @_) } 130 | sub is_log_level { return $_[0] <= $Log_Level } 131 | 132 | sub get_log_buffer { 133 | return \@Log_Buffer; 134 | } 135 | 136 | sub clear_log_buffer { 137 | @Log_Buffer = (); 138 | } 139 | 140 | sub log_emerg { print_log_level(LOG_EMERG, @_) } 141 | sub log_alert { print_log_level(LOG_ALERT, @_) } 142 | sub log_crit { print_log_level(LOG_CRIT, @_) } 143 | sub log_err { print_log_level(LOG_ERR, @_) } 144 | sub log_warning { print_log_level(LOG_WARNING, @_) } 145 | sub log_notice { print_log_level(LOG_NOTICE, @_) } 146 | sub log_info { print_log_level(LOG_INFO, @_) } 147 | sub log_debug { print_log_level(LOG_DEBUG, @_) } 148 | 149 | ############################################################################### 150 | # add_notify($fh); 151 | # 152 | # Add $fh to the list of notification handles. $fh is assumed 153 | # to be a M6::ArpSponge::Control::Server reference. 154 | # 155 | # Returns the $fh argument. 156 | # 157 | ############################################################################### 158 | sub add_notify { 159 | my ($fh) = @_; 160 | $Notify->add($fh); 161 | return $fh; 162 | } 163 | 164 | ############################################################################### 165 | # remove_notify($fh); 166 | # 167 | # Remove $fh from the list of notification handles. $fh is assumed 168 | # to be a M6::ArpSponge::Control::Server reference. 169 | # 170 | # Returns the $fh argument. 171 | # 172 | ############################################################################### 173 | sub remove_notify { 174 | my ($fh) = @_; 175 | $Notify->remove($fh); 176 | return $fh; 177 | } 178 | 179 | ############################################################################### 180 | # print_notify($format, ...); 181 | # 182 | # Print message on the notify handles. 183 | ############################################################################### 184 | sub print_notify($@) { 185 | $Notify || return; 186 | 187 | my $msg = sprintf(@_); 188 | for my $fh ($Notify->can_write(0)) { 189 | $fh->send_log($msg); 190 | } 191 | } 192 | 193 | ############################################################################### 194 | # print_log_level($level, $format, ...); 195 | ############################################################################### 196 | sub print_log_level { 197 | my ($level, $format, @args) = @_; 198 | 199 | return if $level > $Log_Level; 200 | 201 | # Add message to circular log buffer. 202 | foreach (split(/\n/, sprintf($format, @args))) { 203 | push @Log_Buffer, [ time, $_ ]; 204 | if (int(@Log_Buffer) > $Log_Buffer_Size) { 205 | shift @Log_Buffer; 206 | } 207 | } 208 | 209 | print_notify($format, @args); 210 | 211 | if ($Verbose <= 0) { 212 | syslog($level, $format, @args); 213 | return; 214 | } 215 | my $head = strftime("%Y-%m-%d %H:%M:%S ", localtime(time)) 216 | . $Syslog_Ident . "[$$]:"; 217 | print STDOUT map { "$head $_\n" } split(/\n/, sprintf($format, @args)); 218 | return; 219 | } 220 | 221 | ############################################################################### 222 | # print_log($format, ...); 223 | # 224 | # Log $format, ... to syslog. Syntax is identical to that of printf(). 225 | # Prints to STDOUT if verbose or dummy. 226 | ############################################################################### 227 | sub print_log { 228 | my ($format, @args) = @_; 229 | print_log_level($Default_Level, $format, @args); 230 | } 231 | 232 | ############################################################################### 233 | # log_fatal($format, ...); 234 | # 235 | # Log $format, ... to syslog and dies() with the same message. Syntax is 236 | # identical to that of printf(). Prints to STDOUT if verbose or dummy, 237 | # so you may see duplicate messages in that case. 238 | ############################################################################### 239 | sub log_fatal { 240 | my ($format, @args) = @_; 241 | if (@args == 0) { 242 | @args = ($format); 243 | $format = '%s'; 244 | } 245 | log_crit($format, @args); 246 | chomp(my $msg = sprintf($format, @args)); 247 | die "$msg\n"; 248 | } 249 | 250 | ############################################################################### 251 | # log_verbose($level, $arg, ...); 252 | # 253 | # Print the arguments to STDOUT if verbosity is at least $level. 254 | # 255 | ############################################################################### 256 | sub log_verbose($@) { 257 | my ($level, @args) = @_; 258 | 259 | if (log_is_verbose >= $level) { 260 | print STDOUT strftime("%Y-%m-%d %H:%M:%S ", localtime(time)), @args; 261 | } 262 | } 263 | 264 | ############################################################################### 265 | # log_sverbose($level, $fmt, $arg, ...); 266 | # 267 | # Print the arguments to STDOUT if verbosity is at least $level. 268 | # Functions like sprintf(); 269 | # 270 | ############################################################################### 271 | sub log_sverbose($@) { 272 | my ($level, $fmt, @args) = @_; 273 | if (log_is_verbose >= $level) { 274 | print STDOUT strftime("%Y-%m-%d %H:%M:%S ", localtime(time)), 275 | sprintf($fmt, @args); 276 | } 277 | } 278 | 279 | =item XB ( I 280 | [, B<-err> =E I] 281 | ) 282 | 283 | Check whether I represents a valid syslog level. 284 | 285 | If an error occurs, and C<-err> is specified, the scalar behind I will 286 | contain a diagnostic. 287 | 288 | =cut 289 | 290 | sub is_valid_log_level { 291 | my ($arg, %opts) = @_; 292 | my $err_s; 293 | $opts{-err} //= $err_s; 294 | 295 | if (defined (my $level = $STR_TO_LOGLEVEL{lc $arg}) ) { 296 | return $level; 297 | } 298 | 299 | ${$opts{-err}} = q/"$arg" is not a valid syslog level/; 300 | return; 301 | } 302 | 303 | =item XB ( I ) 304 | 305 | Return the string representation of the numerical I. 306 | 307 | =cut 308 | 309 | sub log_level_to_string { 310 | my $level = int($_[0]); 311 | 312 | if ($level > LOG_DEBUG()) { 313 | return $LOGLEVEL_TO_STR{LOG_DEBUG()}; 314 | } 315 | if ($level < LOG_EMERG()) { 316 | return $LOGLEVEL_TO_STR{LOC_EMERG()}; 317 | } 318 | return $LOGLEVEL_TO_STR{$level}; 319 | } 320 | 321 | =head1 COPYRIGHT 322 | 323 | Copyright 2011-2016, AMS-IX B.V. 324 | Distributed under GPL and the Artistic License 2.0. 325 | 326 | =cut 327 | 328 | 1; 329 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Base.pm: -------------------------------------------------------------------------------- 1 | #=============================================================================== 2 | # 3 | # Module: M6::ArpSponge::Base 4 | # File: M6/ARP/Base.pm 5 | # 6 | # Description: Base class for all M6::ArpSponge objects. 7 | # 8 | # Author: Steven Bakker (SB), 9 | # Created: 2010-10-07 10 | # 11 | # Copyright 2010-2016 AMS-IX B.V.; All rights reserved. 12 | # 13 | # This module is free software; you can redistribute it and/or 14 | # modify it under the same terms as Perl itself. See perldoc 15 | # perlartistic. 16 | # 17 | # This program is distributed in the hope that it will be useful, 18 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 20 | # 21 | # See the "Copying" file that came with this package. 22 | # 23 | #=============================================================================== 24 | 25 | package M6::ArpSponge::Base; 26 | 27 | use strict; 28 | #use warnings; 29 | our $VERSION = '1.00'; 30 | 31 | use Scalar::Util qw( reftype ); 32 | use Carp qw( confess ); 33 | 34 | our %attr_names = (); 35 | 36 | ############################################################################ 37 | # Usage : $obj->attr_names(), CLASS->attr_names() 38 | # Purpose : returns the valid (constructor) attributes for the class 39 | # Returns : a REFerence to a hash mapping attribute names to "1". 40 | # Parameters : none 41 | # Throws : no exceptions 42 | # Comments : Takes the class-wide %attr_names from $obj or CLASS. 43 | sub attr_names { 44 | my $class = ref $_[0] || $_[0]; 45 | return eval q(\%).$class.q(::attr_names); 46 | } 47 | 48 | ############################################################################ 49 | # Usage : $obj->parent_attr_names(), CLASS->parent_attr_names() 50 | # Purpose : returns the valid (constructor) attributes for the parents 51 | # of $obj or CLASS. 52 | # Returns : a hash mapping attribute names to "1". 53 | # Parameters : an optional list of additional valid attribute names. 54 | # Throws : no exceptions 55 | # Comments : Similar to attr_names(), but this is typically used in the 56 | # class's code to construct the %attr_names: 57 | # 58 | # package Foo; 59 | # use base qw( Bar ); 60 | # our %attr_names = ( foo=>1, Foo->parent_attr_names ); 61 | # 62 | sub parent_attr_names { 63 | my $self = shift @_; 64 | my $class = ref $self || $self; 65 | return ( 66 | ( map { eval q(%).$_.q(::attr_names) } eval q(@).$class.q(::ISA) ), 67 | ( map { $_ => 1 } @_ ) 68 | ); 69 | } 70 | 71 | ############################################################################ 72 | # Usage : CLASS->new() 73 | # Purpose : constructor 74 | # Returns : a blessed HASH reference 75 | # Parameters : NAME=>VALUE pairs for initial attributes 76 | # Throws : exception in case of invalid attributes 77 | sub new { 78 | my ($type, @args) = @_; 79 | 80 | my $self = $type->parse_named_args(\@args, $type->attr_names); 81 | #my $self = $type->parse_named_args(\@args); 82 | return if ! $self; 83 | 84 | bless $self, $type; 85 | return $self->init(); 86 | } 87 | 88 | sub init { return shift } 89 | 90 | # 1: $obj->parse_named_args(); 91 | # 2: $obj->parse_named_args( undef ); 92 | # 3: $obj->parse_named_args( [ undef ] ); 93 | # 4: $obj->parse_named_args( [ key => val, ... ] ); 94 | # 5: $obj->parse_named_args( [ { key => val, ... } ] ); 95 | # 6: $obj->parse_named_args( { key => val, ... } ); 96 | # 97 | # Optional parameter "$valid_ref" is either { key => 1, ... } or [ key, ... ] 98 | # 99 | sub parse_named_args { 100 | my $self = shift; 101 | 102 | return {} if @_ == 0; # 1 103 | 104 | my $args_ref = shift; 105 | 106 | if (! defined $args_ref) { 107 | return {}; # 2 108 | } 109 | 110 | if (reftype $args_ref ne 'HASH') { 111 | if (reftype $args_ref ne 'ARRAY') { 112 | confess( qq{_named_args: parameter #0 ("$args_ref") not a HASH or}, 113 | qq{ ARRAY ref: $args_ref\n} ); 114 | } 115 | if (!defined $args_ref->[0]) { 116 | return {}; # 3 117 | } 118 | if (@$args_ref % 2 == 0) { 119 | $args_ref = { @$args_ref }; # 4 120 | } 121 | elsif (@$args_ref == 1 && reftype $args_ref->[0] eq 'HASH') { 122 | $args_ref = $args_ref->[0]; # 5 123 | } 124 | else { 125 | confess("_named_args: Odd number of arguments:\n", 126 | " ", join(", ", @$args_ref), "\n"); 127 | } 128 | } 129 | 130 | # default case: it's a hashref # 6 131 | 132 | my %attr; 133 | 134 | while (my ($attr_name, $attr_value) = each %$args_ref) { 135 | $attr_name =~ s/^-+//g; 136 | $attr{lc $attr_name} = $attr_value; 137 | } 138 | 139 | return \%attr if @_ == 0; 140 | 141 | if (my $valid_ref = shift @_) { 142 | if (reftype $valid_ref eq 'ARRAY') { 143 | $valid_ref = { map { $_ => 1 } @$valid_ref }; 144 | } 145 | for my $attr_name (keys %attr) { 146 | if ( ! $valid_ref->{$attr_name} ) { 147 | confess(qq{\nparse_named_args: Bad attribute "$attr_name"; }, 148 | qq{valid: }, join(", ", keys %$valid_ref),"\n"); 149 | } 150 | } 151 | } 152 | return \%attr; 153 | } 154 | 155 | sub _define_accessor { 156 | my $class = shift; 157 | my ($name, $key) = ref $_[0] ? @{$_[0]} : ($_[0], $_[0]); 158 | 159 | my $sub = "sub ${class}::$name {\n" 160 | . " if (\@_ < 2) { return \$_[0]->{'$key'} }\n" 161 | . " my \$s = \$_[0];\n" 162 | . " \$s->{'$key'} = \$_[1];\n" 163 | . " return \$s;\n" 164 | . "}\n" 165 | . ";1\n" 166 | ; 167 | 168 | eval $sub; 169 | 170 | if ($@) { 171 | my $lno = 1; 172 | my @sub = split("\n", $sub); 173 | @sub = map { sprintf("%3d\t$_\n", $lno++) } @sub; 174 | print STDERR "----\n", @sub, "----\n"; 175 | confess($@); 176 | } 177 | return 1; 178 | } 179 | 180 | sub mk_accessors { 181 | my $class = shift; 182 | foreach (@_) { 183 | $class->_define_accessor($_); 184 | } 185 | } 186 | 187 | 1; 188 | 189 | __END__ 190 | 191 | =pod 192 | 193 | =head1 NAME 194 | 195 | M6::ArpSponge::Base - base class for all M6::ArpSponge objects 196 | 197 | =head1 SYNOPSIS 198 | 199 | package M6::ArpSponge::SomeObj; 200 | 201 | use base qw( M6::ArpSponge::Base ); 202 | 203 | our %attr_names = __PACKAGE__->parent_attr_names('banana'); 204 | # (banana=>1, monkey=>1) 205 | 206 | __PACKAGE__->mk_accessors('banana', ['banana_alias' => 'banana']); 207 | 208 | ... 209 | 210 | package main; 211 | 212 | $obj = new M6::ArpSponge::SomeObj; 213 | %attr_names = $obj->attr_names(); # ('monkey'=>1, 'banana'=>1) 214 | 215 | my $monkey = $obj->monkey(); 216 | my $banana = $obj->banana(); 217 | my $banana = $obj->banana_alias(); 218 | 219 | =head1 DESCRIPTION 220 | 221 | C provides a base class for all M6::ArpSponge 222 | objects. It only defines common class methods and does not 223 | look directly at an object's instance data. 224 | 225 | =head1 CONSTRUCTORS 226 | 227 | =over 228 | 229 | =item X B ( I =E I, ... ) 230 | 231 | Simple constructor for a hash-based object. Optional initial attributes 232 | (key/value pairs for the hash) can be specified, and the constructor 233 | will make sure that they comply with the target class' 234 | L. 235 | 236 | Returns a simple HASH ref, blessed into the appropriate 237 | (descendant) package. 238 | 239 | =back 240 | 241 | =head1 METHODS 242 | 243 | =over 244 | 245 | =item XB 246 | 247 | Returns a HASH reference mapping valid attribute names for this class to 248 | "1". Can be called as either a class method or an instance method 249 | (but not as a plain function). 250 | 251 | It assumes that the descendant has defined an I<%attr_names> variable in 252 | its package scope and will use that to return the list of names. 253 | 254 | =item XB ( [I] ) 255 | 256 | Returns a HASH composed of the contents of the 257 | L hashes of all parent classes in this 258 | class's C<@ISA>. 259 | 260 | This is typically only used in a package's set-up code: 261 | 262 | package Bar; 263 | use base qw( M6::ArpSponge::Base ); 264 | our %attr_names = ('bar' => 1, Bar->parent_attr_names); # bar=>1 265 | 266 | package Foo; 267 | use base qw( Bar ); 268 | our %attr_names = ('foo' => 1, Foo->parent_attr_names); # foo=>1, bar=>1 269 | 270 | To shorten the above, it is possible to provide the additional 271 | attribute names in the I argument: 272 | 273 | package Bar; 274 | use base qw( M6::ArpSponge::Base ); 275 | our %attr_names = Bar->parent_attr_names('bar'); # bar=>1 276 | 277 | package Foo; 278 | use base qw( Bar ); 279 | our %attr_names = Foo->parent_attr_names('foo'); # foo=>1, bar=>1 280 | 281 | =item X 282 | B ( I [, I ] ) 283 | 284 | =item B ( I [, I ] ) 285 | 286 | Normalises the keys in I and stores the results in a new hash. 287 | If a I is given instead, it first coerces it into a hash, then 288 | normalises it. 289 | 290 | Key normalisation consists of translating it to lowercase, removing all 291 | spaces and all leading hyphen (C<->, C<-->) characters. 292 | 293 | If I is given (either as an ARRAYREF or a HASHREF), then 294 | (normalised) parameter names are checked against the attribute names 295 | specified there (the elements in "@{I}" or the keys in 296 | "%{I}", resp.). 297 | 298 | If an invalid key is encountered, the function calls 299 | L. 300 | 301 | Can be called as a function or (class) method. 302 | 303 | $args_ref = $obj->parse_named_args( \%args, \@valid ); 304 | $args_ref = CLASS->parse_named_args( \@_, \%valid ); 305 | 306 | The function returns a reference to the new (normalised) hash. 307 | 308 | Example: 309 | 310 | package Something; 311 | use base qw( M6::ArpSponge::Base ); 312 | 313 | sub do_something { 314 | my $self = shift; 315 | 316 | print "args:", (map { qq{ "$_"} } @_), "\n"; 317 | 318 | my $args = $self->parse_named_args( \@_, [qw( foo bar )]); 319 | 320 | while ( my ($k, $v) = each %$args ) { 321 | print qq{"$k" => "$v"\n}; 322 | } 323 | } 324 | 325 | Something->do_something(--FOO => 'my foo', -bAr => 'my BAR'); 326 | 327 | Prints: 328 | 329 | args: "--FOO" "my foo" "-bAr" "my BAR" 330 | "bar" => "my BAR" 331 | "foo" => "my foo" 332 | 333 | =back 334 | 335 | =head1 SEE ALSO 336 | 337 | L, 338 | L. 339 | 340 | =head1 AUTHOR 341 | 342 | Steven Bakker Esteven.bakker@ams-ix.netE, AMS-IX B.V.; 2010. 343 | 344 | =head1 COPYRIGHT 345 | 346 | Copyright 2010-2016, AMS-IX B.V. 347 | Distributed under GPL and the Artistic License 2.0. 348 | 349 | =cut 350 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Queue.pm: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # 3 | # ARP Query Timestamp Queue 4 | # 5 | # Copyright 2005-2016 AMS-IX B.V.; All rights reserved. 6 | # 7 | # This module is free software; you can redistribute it and/or 8 | # modify it under the same terms as Perl itself. See perldoc 9 | # perlartistic. 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. 14 | # 15 | # See the "Copying" file that came with this package. 16 | # 17 | # A.Vijn, 2003-2004; 18 | # S.Bakker, 2004-2010; 19 | # 20 | ############################################################################### 21 | package M6::ArpSponge::Queue; 22 | 23 | use strict; 24 | 25 | BEGIN { 26 | our $VERSION = 1.04; 27 | } 28 | 29 | our $DFL_DEPTH = 1000; 30 | 31 | use M6::ArpSponge::Log; 32 | 33 | =pod 34 | 35 | =head1 NAME 36 | 37 | M6::ArpSponge::Queue - ARP query queue. 38 | 39 | =head1 SYNOPSIS 40 | 41 | use M6::ArpSponge::Queue; 42 | 43 | $q = new M6::ArpSponge::Queue($max_depth); 44 | 45 | $q->clear($dst_ip); 46 | $q->add($dst_ip, $src_ip, $timestamp); 47 | 48 | $q->clear_all(); 49 | 50 | while ( ! $q->is_full($dst_ip) ) { 51 | ... 52 | } 53 | 54 | $q_depth_1 = $q->depth($dst_ip); 55 | $q->reduce($dst_ip, 0.750); 56 | $q_depth_2 = $q->depth($dst_ip); 57 | $q_first = $q->get($dst_ip, 0); 58 | $q_last = $q->get($dst_ip, -1); 59 | 60 | $q_per_min = $q->rate($dst_ip); 61 | 62 | $listref = $q->get_queue($dst_ip); 63 | print "timestamps: ", join(", ", map { $_->[1] } @{$listref}), "\n"; 64 | 65 | =head1 DESCRIPTION 66 | 67 | This object class is used by the L 68 | module to store [source, timestamp] tuples for ARP queries. 69 | 70 | The object holds a collection of circular buffers that are accessed by 71 | unique keys (IP address strings in the typical usage scenario). Pairs 72 | of source IP and timestamp data added to a queue until its size reaches 73 | the maximum depth, at which point newly added values cause the oldest 74 | values to be shifted off the queue. 75 | 76 | =head1 IP AND MAC ADDRESS REPRESENTATION 77 | 78 | Although the L(8) stores IP and MAC addresses as hexadecimal 79 | strings, and this object module is designed to do the same, there is in 80 | fact no implicit knowledge about the format of the IP and MAC addresses 81 | in this module; I could stand for I and 82 | I could stand for I. 83 | 84 | =head1 VARIABLES 85 | 86 | =over 87 | 88 | =item X<$M6::ArpSponge::Queue::DFL_DEPTH>I<$M6::ArpSponge::Queue::DFL_DEPTH> 89 | 90 | Default maximum depth for queue objects (1000). 91 | 92 | =back 93 | 94 | =head1 CONSTRUCTOR 95 | 96 | =over 97 | 98 | =item XB ( [ I ] ) 99 | 100 | Create a new object instance. Each queue will have a maximum depth 101 | of I (or I<$M6::ArpSponge::Queue::DFL_DEPTH> if not given). 102 | Returns a reference to the newly created object. 103 | 104 | =cut 105 | 106 | sub new { 107 | my ($type, $max_depth) = @_; 108 | 109 | $max_depth //= $DFL_DEPTH; 110 | 111 | $type = ref $type if ref $type; 112 | bless {'max_depth' => $max_depth, q=>{}}, $type; 113 | } 114 | 115 | =back 116 | 117 | =head1 METHODS 118 | 119 | =over 120 | 121 | =item XB 122 | 123 | Clear all queues. 124 | 125 | =cut 126 | 127 | sub clear_all { %{$_[0]->{'q'}} = () } 128 | 129 | =item XB ( I ) 130 | 131 | Clear the queue for I. 132 | 133 | =cut 134 | 135 | sub clear { delete $_[0]->{'q'}->{$_[1]} } 136 | 137 | =item XB ( I ) 138 | 139 | Return the depth of the queue for I. 140 | 141 | =cut 142 | 143 | sub depth { 144 | my $q = $_[0]->get_queue($_[1]); 145 | return $q ? int(@$q) : 0 146 | } 147 | 148 | =item XB ( I ) 149 | 150 | Return the (average) query rate (as a real number) for I in queries 151 | per minute. 152 | 153 | =cut 154 | 155 | # Slightly tricky calculation. Dumb calculation would be: 156 | # 157 | # n / (Tn - T1) 158 | # 159 | # Where "n" is the number of entries, "T1" is the timestamp 160 | # of the first entry, and "Tn" is the n-th timestamp. 161 | # 162 | # However, this skews the calculation somewhat (the shorter the queue, the 163 | # worse the skew... hey, that rhymes!). 164 | # 165 | # Consider the case where we send a packet once every second: 166 | # 167 | # Packet 1 at time 0 168 | # Packet 2 at time 1 169 | # 170 | # In the queue we now have two entries, with timestamps 0 and 1, resp. 171 | # Using the above formula, we get a rate of _two_ packets per second! 172 | # That's clearly wrong. Even worse, the rate slowly aproaches 1 the 173 | # further we go: 174 | # 175 | # Packet 3 at time 2 => rate = 1.5 176 | # Packet 4 at time 3 => rate = 1.3333 177 | # Packet 5 at time 4 => rate = 1.2 178 | # ... 179 | # Packet 100 at time 99 => rate = 1.0101 180 | # 181 | # The correct way to handle this is to not count the first entry as part 182 | # of the "n". After all, the rate of packets is calculated by looking at 183 | # the gaps between them, and there is no gap _before_ the first packet. 184 | # 185 | # Hence, the corrected formula is: 186 | # 187 | # (n-1) / (Tn - T1) 188 | # 189 | # Which gives the correct rate of "1" for the above examples. 190 | # 191 | # [Statistics: comment/code > 4] 192 | # 193 | sub rate { 194 | my $q = $_[0]->get_queue($_[1]); 195 | return undef if !defined($q) || @$q <= 1; 196 | my $first = $q->[0]->[1]; 197 | my $last = $q->[$#$q]->[1]; 198 | my $time = ($first < $last) ? $last-$first : 1; 199 | my $n = int(@$q)-1; 200 | return ($n / $time) * 60; 201 | } 202 | 203 | =item B( [ I ] ) 204 | X 205 | 206 | Return or set the maximum depth of the queues. 207 | 208 | =cut 209 | 210 | sub max_depth { 211 | my ($self, @args) = @_; 212 | if (@args) { 213 | $self->{'max_depth'} = shift @args; 214 | } 215 | return $self->{'max_depth'} 216 | } 217 | 218 | =item B ( I ) 219 | X 220 | 221 | Return whether or not the queue for I is full, i.e. is wrapping. 222 | 223 | =cut 224 | 225 | sub is_full { $_[0]->depth($_[1]) >= $_[0]->max_depth } 226 | 227 | =item XB ( I, I, I ) 228 | 229 | Add [I, I] to the queue for I, 230 | wrapping the buffer ring if necessary. Returns the new 231 | queue depth. 232 | 233 | =cut 234 | 235 | sub add { 236 | my ($self, $ip, $src_ip, $val) = @_; 237 | 238 | # Oooh, very h4xx|| 239 | my $q = $self->{'q'}->{$ip} // 240 | ($self->{'q'}->{$ip} = []); 241 | 242 | if (int(@$q) >= $self->max_depth) { 243 | shift @$q; 244 | } 245 | push @$q, [ $src_ip, $val ]; 246 | return int(@$q); 247 | } 248 | 249 | 250 | =item XB ( I [, I] ) 251 | 252 | Return the [I, I] data tuple at position I 253 | in the queue for I. Zero (0) is the oldest; positive values for 254 | I give increasingly more recent values. Negative numbers count 255 | from the end of the queue, so C<-1> gives the most recently added value. 256 | 257 | Compare: 258 | 259 | QUEUE->get( IP, -n ) == QUEUE->get( IP, QUEUE->depth(IP) - n ) 260 | 261 | QUEUE->get( IP ) == QUEUE->get( IP, 0 ); 262 | 263 | Also: 264 | 265 | QUEUE->get( IP, n ) == QUEUE->get-_queue( IP )->[n] 266 | 267 | =cut 268 | 269 | sub get_entry { 270 | my ($self, $ip, $index) = @_; 271 | 272 | my $q = $self->get_queue($ip); 273 | $index = 0 unless defined($index); 274 | if ($index < 0) { 275 | $index = int(@$q) + $index; 276 | $index = 0 if $index < 0; 277 | } 278 | return $q->[$index]; 279 | } 280 | 281 | =item XB ( I [, I] ) 282 | 283 | =item XB ( I [, I] ) 284 | 285 | Return the I at position I 286 | in the queue for I. The value of I has the same meaning 287 | as for C above. 288 | 289 | =cut 290 | 291 | sub get_timestamp { 292 | my ($self, $ip, $index) = @_; 293 | 294 | if (my $entry = $self->get_entry($ip, $index)) { 295 | return $entry->[1]; 296 | } 297 | return undef; 298 | } 299 | 300 | sub get { 301 | my ($self, $ip, $index) = @_; 302 | 303 | if (my $entry = $self->get_entry($ip, $index)) { 304 | return $entry->[1]; 305 | } 306 | return undef; 307 | } 308 | 309 | =item XB ( I ) 310 | 311 | Return the timestamps for I. 312 | I this is a reference to the internal list of data, so take care 313 | that you don't inadvertently modify it. 314 | 315 | =cut 316 | 317 | sub get_queue { return $_[0]->{'q'}->{$_[1]} } 318 | 319 | =item XB ( I, I ) 320 | 321 | Reduce the queue for I by comparing subsequent pairs of entries for 322 | each source IP and removing the older one if the time delta between the 323 | two is below 1/I. This effectively means that a source that's 324 | sending more than I ARP queries per second will be largely 325 | ignored. This can mitigate the effects of broadcast storms (e.g. due 326 | to loops) or DoS attacking. 327 | 328 | Returns the new queue depth after reducing. 329 | 330 | =cut 331 | 332 | sub reduce { 333 | my ($self, $ip, $max_rate) = @_; 334 | 335 | my $q = $self->get_queue($ip); 336 | 337 | if (!$q || @{$q} == 0) { 338 | return 0; 339 | } 340 | if ($max_rate <= 0) { 341 | return int(@$q); 342 | } 343 | 344 | my $min_delta = 1/$max_rate; 345 | 346 | my @sorted = sort { $$a[0] cmp $$b[0] || $$a[1] <=> $$b[1] } @$q; 347 | my @reduced = (); 348 | my $prev_entry = undef; 349 | for my $entry (@sorted) { 350 | if ($prev_entry) { 351 | if ($entry->[0] ne $prev_entry->[0] or 352 | $entry->[1] - $prev_entry->[1] >= $min_delta) 353 | { 354 | push @reduced, $prev_entry; 355 | } 356 | } 357 | $prev_entry = $entry; 358 | } 359 | push @reduced, $prev_entry; 360 | @$q = sort { $$a[1] <=> $$b[1] } @reduced; 361 | return int(@reduced); 362 | } 363 | 364 | 1; 365 | 366 | __END__ 367 | 368 | =back 369 | 370 | =head1 EXAMPLE 371 | 372 | use M6::ArpSponge::Queue; 373 | use M6::ArpSponge::Util qw( :all ); 374 | use Time::HiRes qw( usleep time ); 375 | use POSIX qw( strftime ); 376 | 377 | my $some_ip_s = '10.1.1.1'; 378 | my $some_ip = ip2hex($some_ip_s); 379 | my @src_ip = map { ip2hex($_) } qw(10.1.1.2 10.1.1.3 10.1.1.4); 380 | my $max_rate = 10; 381 | 382 | $q = new M6::ArpSponge::Queue(100); 383 | 384 | printf("Filling queue for $some_ip_s (max %d)\n", $q->max_depth); 385 | 386 | $q->clear($some_ip); 387 | my $n = 0; 388 | while (!$q->is_full($some_ip)) { 389 | my $src_ip = $src_ip[$n]; 390 | $n = ($n + 1) % int(@src_ip); 391 | $q->add($some_ip, $src_ip, time); 392 | print STDERR sprintf("\rdepth: %3d", $q->depth($some_ip)); 393 | usleep(rand(5e4)); 394 | } 395 | print "\rBefore reduce:\n"; 396 | printf(" depth: %3d\n", $q->depth($some_ip)); 397 | print strftime(" first: %H:%M:%S\n", 398 | localtime($q->get($some_ip, 0))); 399 | print strftime(" last: %H:%M:%S\n", 400 | localtime($q->get($some_ip, -1))); 401 | printf(" rate: %0.2f queries/minute\n", $q->rate($some_ip)); 402 | 403 | #$" = ","; 404 | #foreach $entry (@{$q->get_queue($some_ip)}) { 405 | # print qq{[@$entry]\n}; 406 | #} 407 | 408 | $q->reduce($some_ip, $max_rate); 409 | print "\nAfter reduce:\n"; 410 | printf(" depth: %3d\n", $q->depth($some_ip)); 411 | print strftime(" first: %H:%M:%S\n", 412 | localtime($q->get($some_ip, 0))); 413 | print strftime(" last: %H:%M:%S\n", 414 | localtime($q->get($some_ip, -1))); 415 | printf(" rate: %0.2f queries/minute\n", $q->rate($some_ip)); 416 | 417 | #foreach $entry (@{$q->get_queue($some_ip)}) { 418 | # print qq{[@$entry]\n}; 419 | #} 420 | 421 | 422 | Output: 423 | 424 | Filling queue for 10.1.1.1 (max 100) 425 | 100 426 | Before reduce: 427 | depth: 100 428 | first: 00:43:44 429 | last: 08:43:04 430 | rate: 2451.50 queries/minute 431 | 432 | After reduce: 433 | depth: 18 434 | first: 00:18:08 435 | last: 08:43:04 436 | rate: 438.50 queries/minute 437 | 438 | =head1 SEE ALSO 439 | 440 | L, L, 441 | L. 442 | 443 | =head1 AUTHORS 444 | 445 | Steven Bakker at AMS-IX (steven.bakker@ams-ix.net). 446 | 447 | =head1 COPYRIGHT 448 | 449 | Copyright 2005-2016, AMS-IX B.V. 450 | Distributed under GPL and the Artistic License 2.0. 451 | 452 | =cut 453 | -------------------------------------------------------------------------------- /init.d/arpsponge.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ### BEGIN INIT INFO 3 | # Provides: @NAME@ 4 | # Required-Start: $network 5 | # Required-Stop: $network 6 | # Default-Start: 2 3 4 5 7 | # Default-Stop: 0 1 6 8 | # Short-Description: @NAME@ daemon 9 | ### END INIT INFO 10 | 11 | ############################################################################# 12 | ############################################################################# 13 | # 14 | # Start-up script for the arpsponge program. 15 | # 16 | ############################################################################# 17 | 18 | if [ -e /lib/lsb/init-functions ]; then 19 | . /lib/lsb/init-functions 20 | fi 21 | 22 | BINDIR=@BINDIR@ 23 | #BINDIR=../bin 24 | PATH=/sbin:/bin:/usr/bin:${BINDIR} 25 | 26 | PROG=@NAME@ 27 | SPONGE_VAR=@SPONGE_VAR@ 28 | ETC_DEFAULT=@ETC_DEFAULT@ 29 | 30 | # Program defaults 31 | export \ 32 | AGE \ 33 | ARP_UPDATE_METHOD \ 34 | DISABLED \ 35 | DUMMY_MODE \ 36 | FLOOD_PROTECTION \ 37 | GRATUITOUS \ 38 | INIT_MODE \ 39 | LEARNING \ 40 | LOG_MASK \ 41 | PASSIVE_MODE \ 42 | PENDING \ 43 | PERMISSIONS \ 44 | PROBERATE \ 45 | QUEUE_DEPTH \ 46 | RATE \ 47 | SPONGE_NETWORK \ 48 | STATIC_MODE \ 49 | SWEEP \ 50 | SWEEP_AT_START \ 51 | SWEEP_SKIP_ALIVE 52 | 53 | Main() { 54 | # Defaults for all sponges. 55 | if [ -f "${ETC_DEFAULT}/${PROG}/defaults" ]; then 56 | . "${ETC_DEFAULT}/${PROG}/defaults" 57 | # Make sure the "defaults" file doesn't accidentally overwrite 58 | # our ETC_DEFAULT. 59 | ETC_DEFAULT=@ETC_DEFAULT@ 60 | 61 | check_global_unset DEVICE NETWORK STATIC_STATE_FILE 62 | fi 63 | 64 | case "$1" in 65 | debug) 66 | SPONGE_DEBUG=true 67 | start 68 | ;; 69 | start) 70 | start re-init 71 | ;; 72 | restart) 73 | status re-init 74 | stop 75 | start re-init 76 | ;; 77 | reload|force-reload) 78 | status re-init 79 | stop 80 | start re-init 81 | ;; 82 | flush) 83 | stop 84 | start 85 | ;; 86 | status) 87 | status 88 | ;; 89 | stop) 90 | status re-init 91 | stop 92 | ;; 93 | help) 94 | do_help 95 | ;; 96 | *) 97 | echo "Usage: $0 {start|stop|restart|flush|reload|force-reload}" 98 | exit 1 99 | ;; 100 | esac 101 | 102 | exit $? 103 | } 104 | 105 | 106 | start() { 107 | local config_dir="$ETC_DEFAULT/${PROG}" 108 | SPONGES=$(find_legacy_interface_configs "$config_dir") 109 | 110 | if [ -d "$config_dir/interfaces.d" ]; then 111 | # Allow interface configs to be put in "interfaces.d" 112 | # sub-directory, so the name can be anything, including 113 | # "defaults". 114 | if [ -n "$SPONGES" ]; then 115 | echo "${PROG}: WARNING: interface configurations" \ 116 | "will be taken from $config_dir/interfaces.d" 117 | echo "${PROG}: WARNING: interface configurations" \ 118 | "from $config_dir will be ignored: $SPONGES" 119 | fi 120 | config_dir="$config_dir/interfaces.d" 121 | SPONGES=$(find_interface_configs $config_dir) 122 | fi 123 | 124 | if [ -n "${SPONGES}" ] 125 | then 126 | echo "Starting ${PROG}(s):" 127 | for file in ${SPONGES} 128 | do 129 | start_sponge "$1" ${file} 130 | done 131 | else 132 | echo "${PROG}: WARNING: no interface configuration files found in" \ 133 | "$config_dir -- no ${PROG}(s) started" 134 | fi 135 | return 0 136 | } 137 | 138 | 139 | stop() { 140 | echo "Stopping ${PROG}(s):" 141 | local pf 142 | local pid 143 | local cruft 144 | for pf in ${SPONGE_VAR}/*/pid 145 | do 146 | if [ -f "$pf" ] 147 | then 148 | read pid cruft <"${pf}" 149 | iface=$(basename $(dirname "${pf}")) 150 | printf " interface=%-10s pid=%-6s " "${iface}" "${pid}" 151 | # Don't use kill -0. The point is to check whether the process 152 | # exists, not whether we can send it a signal. 153 | if ps -p "${pid}" > /dev/null 2>&1 154 | then 155 | kill -TERM "${pid}" 156 | sleep 1 157 | if ps -p "${pid}" > /dev/null 2>&1 158 | then 159 | kill -KILL "${pid}" 160 | echo KILLED 161 | else 162 | echo terminated 163 | fi 164 | else 165 | echo already dead 166 | /bin/rm -f "${pf}" 167 | fi 168 | fi 169 | done 170 | return 0 171 | } 172 | 173 | 174 | status() { 175 | local pidfiles 176 | 177 | pidfiles=$(find ${SPONGE_VAR} -mindepth 2 -maxdepth 2 \ 178 | -type f -name pid 2>/dev/null) 179 | 180 | if [ ! -n "$pidfiles" ]; then 181 | if [ "X$1" != "Xre-init" ]; then 182 | echo " no arpsponge instance running" 183 | fi 184 | return 1 185 | fi 186 | 187 | local isroot=false 188 | 189 | [ `id -u` = 0 ] && isroot=true 190 | 191 | if [ "X$1" = "Xre-init" ]; then 192 | echo "Saving state:" 193 | else 194 | echo "Arpsponge status:" 195 | fi 196 | 197 | local retval=0 198 | local pf 199 | local pid 200 | local cruft 201 | for pf in $pidfiles 202 | do 203 | if [ -f "$pf" ] 204 | then 205 | read pid cruft <"${pf}" 206 | rundir=$(dirname "${pf}") 207 | iface=$(basename "${rundir}") 208 | socket="${rundir}/control" 209 | status="${rundir}/status" 210 | printf " interface=%-10s pid=%-6s " "${iface}" "${pid}" 211 | if ps -p "${pid}" > /dev/null 2>&1 212 | then 213 | if $isroot 214 | then 215 | out=$( 216 | ${BINDIR}/asctl \ 217 | --socket="${socket}" \ 218 | -c dump status "${status}" \ 219 | 2>&1 220 | ) 221 | if [ $? -eq 0 ]; then 222 | echo "[Ok]" 223 | [ -n "$out" ] && echo " $out" 224 | else 225 | retval=1 226 | echo "[FAILED]" 227 | [ -n "$out" ] && echo " $out" 228 | fi 229 | else 230 | echo "[Ok]" 231 | fi 232 | else 233 | retval=1 234 | echo "[FAILED]" 235 | fi 236 | fi 237 | done 238 | return $retval 239 | } 240 | 241 | 242 | do_help() { 243 | cat </dev/null 330 | 331 | [ $? -eq 0 ] && echo "[Ok]" || echo "[FAILED]" 332 | 333 | if [ "$mode" = "re-init" ] && [ -f "${rundir}/status" ] 334 | then 335 | ${BINDIR}/asctl \ 336 | --interface="${DEVICE}" \ 337 | -c load status "${rundir}/status" 338 | fi 339 | 340 | if eval_bool "${STATIC_MODE}" && [ -n "${STATIC_STATE_FILE}" ] 341 | then 342 | ${BINDIR}/asctl \ 343 | --interface="${DEVICE}" \ 344 | -c load status --force "${STATIC_STATE_FILE}" 345 | fi 346 | ) 347 | } 348 | 349 | # LIST=$(find_legacy_interface_configs DIR) 350 | # 351 | # List legacy configuration files in DIR. 352 | # 353 | # This is basically any regular file in DIR 354 | # that starts with `eth` 355 | # 356 | find_legacy_interface_configs() { 357 | local config_dir=$1 358 | find "$config_dir" \ 359 | -maxdepth 1 \ 360 | -type f \ 361 | -name 'eth*' \ 362 | | sort 2>/dev/null 363 | } 364 | 365 | # LIST=$(find_interface_configs DIR) 366 | # 367 | # List configuration files in DIR. 368 | # 369 | # This is basically any regular, non-hidden 370 | # file in DIR. 371 | # 372 | find_interface_configs() { 373 | local config_dir=$1 374 | find "$config_dir" \ 375 | -maxdepth 1 \ 376 | -type f \ 377 | \! -name '.*' \ 378 | | sort 2>/dev/null 379 | } 380 | 381 | # check_global_unset VAR1 VAR2 ... 382 | # 383 | # Check if variables VAR1 ... have values set. 384 | # If so, issue a warning. 385 | # 386 | check_global_unset() { 387 | local val 388 | local varname 389 | for varname in "$@"; do 390 | eval val="\$$varname" 391 | if [ -n "$val" ]; then 392 | echo "${PROG}: WARNING: global $varname setting" \ 393 | "will be ignored; specify in the interface-specific" \ 394 | "configuration instead" 395 | fi 396 | done 397 | } 398 | 399 | # eval_bool $var && echo TRUE 400 | # 401 | # Evaluate "$var" as a boolean expression. 402 | # $? status indicates true/false. 403 | # 404 | eval_bool() { 405 | var=$1 406 | case $var in 407 | [1-9]*|0[1-9]*|y|yes|true|on|Y|YES|TRUE|ON) 408 | true 409 | return;; 410 | *) 411 | false 412 | return;; 413 | esac 414 | } 415 | 416 | 417 | # fatal MSG ... 418 | fatal() { 419 | echo "** arpsponge init error:" $@ >&2 420 | exit 1 421 | } 422 | 423 | 424 | # opts=$(fix_opts_bool "$opts" "$opt" "$val") 425 | # 426 | # Add "$opt" to "$opts" if "$val" evaluates to true. 427 | # 428 | fix_opts_bool() { 429 | local opts="$1" 430 | local opt="$2" 431 | local val="$3" 432 | eval_bool "$val" && opts="$opts $opt" 433 | echo "$opts" 434 | } 435 | 436 | 437 | # opts=$(fix_opts "$opts" "$opt" "$val") 438 | # 439 | # Add "$opt=$val" to "$opts" if "$val" has length > 0 440 | # 441 | fix_opts() { 442 | local opts="$1" 443 | local opt="$2" 444 | local val="$3" 445 | [ -n "$val" ] && opts="$opts $opt=$val" 446 | echo "$opts" 447 | } 448 | 449 | Main "$@" 450 | exit $? 451 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/NetPacket.pm: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # 3 | # ARP Sponge network packet routines. 4 | # 5 | # Copyright 2011-2016 AMS-IX B.V.; All rights reserved. 6 | # 7 | # This module is free software; you can redistribute it and/or 8 | # modify it under the same terms as Perl itself. See perldoc 9 | # perlartistic. 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. 14 | # 15 | # See the "Copying" file that came with this package. 16 | # 17 | # Most of the basic decoding was ripped from the original NetPacket:: 18 | # modules. 19 | # 20 | # S.Bakker. 21 | # 22 | ############################################################################### 23 | package M6::ArpSponge::NetPacket; 24 | 25 | use strict; 26 | use Readonly; 27 | 28 | BEGIN { 29 | use Exporter; 30 | 31 | our $VERSION = 1.04; 32 | our @ISA = qw( Exporter ); 33 | 34 | my @functions = qw( 35 | decode_ethernet decode_ip decode_ipv4 decode_arp 36 | encode_ethernet encode_arp 37 | ); 38 | 39 | my @variables = qw( 40 | $ETH_TYPE_IP 41 | $ETH_TYPE_IPv4 42 | $ETH_TYPE_ARP 43 | $ETH_TYPE_IPv6 44 | $ETH_ADDR_BROADCAST $ETH_ADDR_NONE 45 | $IPv4_ADDR_BROADCAST $IPv4_ADDR_NONE 46 | $ARP_OPCODE_REQUEST $ARP_OPCODE_REPLY 47 | $ARP_HTYPE_ETHERNET $ARP_HLEN_ETHERNET 48 | $ARP_PROTO_IPv4 $ARP_PLEN_IPv4 49 | $ARP_PROTO_IP 50 | ); 51 | 52 | our @EXPORT_OK = ( @functions, @variables ); 53 | our @EXPORT = (); 54 | 55 | our %EXPORT_TAGS = ( 56 | 'all' => [ @EXPORT_OK ], 57 | 'func' => [ @functions ], 58 | 'vars' => [ @variables ], 59 | ); 60 | } 61 | 62 | # The only things we're interested in right now... 63 | Readonly our $ETH_TYPE_IP => 0x0800; 64 | Readonly our $ETH_TYPE_IPv4 => 0x0800; 65 | Readonly our $ETH_TYPE_ARP => 0x0806; 66 | Readonly our $ETH_TYPE_IPv6 => 0x86dd; 67 | 68 | Readonly our $ARP_OPCODE_REQUEST => 1; 69 | Readonly our $ARP_OPCODE_REPLY => 2; 70 | Readonly our $ARP_HTYPE_ETHERNET => 1; 71 | Readonly our $ARP_PROTO_IP => $ETH_TYPE_IPv4; 72 | Readonly our $ARP_PROTO_IPv4 => $ETH_TYPE_IPv4; 73 | Readonly our $ARP_HLEN_ETHERNET => 6; 74 | Readonly our $ARP_PLEN_IPv4 => 4; 75 | 76 | Readonly our $ETH_ADDR_BROADCAST => 'ff' x $ARP_HLEN_ETHERNET; 77 | Readonly our $IPv4_ADDR_BROADCAST => 'ff' x $ARP_PLEN_IPv4; 78 | Readonly our $ETH_ADDR_NONE => '00' x $ARP_HLEN_ETHERNET; 79 | Readonly our $IPv4_ADDR_NONE => '00' x $ARP_PLEN_IPv4; 80 | 81 | =pod 82 | 83 | =head1 NAME 84 | 85 | M6::ArpSponge::NetPacket - (partially) decode ethernet, IP and ARP packets 86 | 87 | =head1 SYNOPSIS 88 | 89 | use M6::ArpSponge::NetPacket qw( :all ); 90 | use M6::ArpSponge::Util qw( :all ); 91 | 92 | $packet = ...; 93 | 94 | $eth_data = decode_ethernet($packet); 95 | 96 | if ( $eth_data->{type} == $ETH_TYPE_IPv4 ) { 97 | $ip_data = decode_ipv4( $eth_data->{'data'} ); 98 | 99 | printf( "%s -> %s, %d bytes (including IP header)\n", 100 | hex2ip( $ip_data->{'src_ip'} ), 101 | hex2ip( $ip_data->{'dest_ip'} ), 102 | $ip_data->{'len'} ); 103 | } 104 | 105 | if ( $eth_data->{type} == $ETH_TYPE_ARP ) { 106 | $arp_data = decode_arp( $eth_data->{'data'} ); 107 | 108 | if ($arp_data->{opcode} == $ARP_OPCODE_REQUEST) { 109 | printf( "ARP WHO-HAS %s TELL %s\@%s\n", 110 | hex2ip( $arp_data->{'tpa'} ), 111 | hex2ip( $arp_data->{'spa'} ), 112 | hex2mac( $arp_data->{'sha'} ) ); 113 | } 114 | else { 115 | printf( "ARP %s IS-AT %s\n", 116 | hex2ip( $arp_data->{'spa'} ), 117 | hex2ip( $arp_data->{'sha'} ) ); 118 | } 119 | } 120 | 121 | =head1 DESCRIPTION 122 | 123 | This module defines a number of routines to decode raw pcap packet data 124 | on Ethernet, IP and ARP level. 125 | 126 | The semantics are similar to those of the L(3) family, except that: 127 | 128 | =over 129 | 130 | =item 1. 131 | 132 | All IP and MAC addresses are decoded as hex strings (as opposed to what e.g. 133 | L(3) does). 134 | 135 | =item 2. 136 | 137 | We decode only a minimal subset of a packet, just enough for the 138 | L(1)'s purposes. 139 | 140 | =back 141 | 142 | =head1 VARIABLES 143 | 144 | The variables below can be imported individually, by using the C<:vars> or C<:all> tags: 145 | 146 | use M6::ArpSponge::NetPacket qw( :vars ); 147 | use M6::ArpSponge::NetPacket qw( :all ); 148 | 149 | Note that these variables are all read-only. 150 | 151 | =over 152 | 153 | =item X<$ETH_TYPE_IP>I<$ETH_TYPE_IP>, X<$ETH_TYPE_IPv4>I<$ETH_TYPE_IPv4> 154 | 155 | Ethernet C for IPv4 frames. 156 | 157 | =item X<$ETH_TYPE_IPv6>I<$ETH_TYPE_IPv6> 158 | 159 | Ethernet C for IPv6 frames. 160 | 161 | =item X<$ETH_TYPE_ARP>I<$ETH_TYPE_ARP> 162 | 163 | Ethernet C for ARP frames. 164 | 165 | =item X<$ETH_ADDR_BROADCAST>I<$ETH_ADDR_BROADCAST> 166 | 167 | Hex string representing the ethernet broadcast address ('ff' x 6). 168 | 169 | =item X<$IPv4_ADDR_BROADCAST>I<$IPv4_ADDR_BROADCAST> 170 | 171 | Hex string representing the IPv4 broadcast address ('ff' x 4). 172 | 173 | =item X<$ETH_ADDR_NONE>I<$ETH_ADDR_NONE> 174 | 175 | Hex string representing the "zero" ethernet address ('00' x 6). 176 | 177 | =item X<$IPv4_ADDR_NONE>I<$IPv4_ADDR_NONE> 178 | 179 | Hex string representing the IPv4 "zero" address ('00' x 4). 180 | 181 | =item X<$ARP_OPCODE_REQUEST>I<$ARP_OPCODE_REQUEST> 182 | 183 | ARP C for ARP requests. 184 | 185 | =item X<$ARP_OPCODE_REPLY>I<$ARP_OPCODE_REPLY> 186 | 187 | ARP C for ARP replies. 188 | 189 | =item X<$ARP_HTYPE_ETHERNET>I<$ARP_HTYPE_ETHERNET> 190 | 191 | ARP C for Ethernet hardware addresses. 192 | 193 | =item X<$ARP_PROTO_IP>I<$ARP_PROTO_IP>, X<$ARP_PROTO_IPv4>I<$ARP_PROTO_IPv4> 194 | 195 | ARP C for IPv4 requests/replies. 196 | 197 | =item X<$ARP_HLEN_ETHERNET>I<$ARP_HLEN_ETHERNET> 198 | 199 | Ethernet protocol address length in bytes (6). 200 | 201 | =item X<$ARP_PLEN_IPv4>I<$ARP_PLEN_IPv4> 202 | 203 | IP protocol address length in bytes (4). 204 | 205 | =back 206 | 207 | =head1 FUNCTIONS 208 | 209 | The functions below can be imported individually, by using the C<:func> or C<:all> tags: 210 | 211 | use M6::ArpSponge::NetPacket qw( :all ); 212 | use M6::ArpSponge::NetPacket qw( :func ); 213 | 214 | All functions return a hash ref (not an object!) with a minimal set of fields 215 | set. They do not set C<_parent> or C<_frame>. 216 | 217 | =over 218 | 219 | =item XB ( I ) 220 | 221 | (TCP/IP Illustrated, Volume 1, Section 2.2, p21-23.) 222 | 223 | Decode I as a raw Ethernet frame. Returns a hash with the following 224 | fields: 225 | 226 | =over 12 227 | 228 | =item C 229 | 230 | Source MAC address as a 12 digit, lowercase hex string. 231 | 232 | =item C 233 | 234 | Destination MAC address as a 12 digit, lowercase hex string. 235 | 236 | =item C 237 | 238 | Integer denoting the Ethernet type field. 239 | 240 | =item C 241 | 242 | Payload data of the Ethernet frame. 243 | 244 | =back 245 | 246 | =cut 247 | 248 | sub decode_ethernet { 249 | my ($pkt) = @_; 250 | return {} if !defined $pkt; 251 | 252 | my %self = (); 253 | # Much faster than the "Nn" + sprintf() trick. 254 | @self{'dest_mac','src_mac','type','data'} = unpack('H12H12na*', $pkt); 255 | return \%self; 256 | } 257 | 258 | ############################################################################### 259 | 260 | =item XB ( I ) 261 | 262 | (TCP/IP Illustrated, Volume 1, Section 2.2, p21-23.) 263 | 264 | Encode I as a raw Ethernet frame. Returns a scalar with 265 | the raw data. I should point to a hash with the following fields: 266 | 267 | =over 12 268 | 269 | =item C 270 | 271 | Source MAC address as a 12 digit, lowercase hex string. 272 | 273 | =item C 274 | 275 | Destination MAC address as a 12 digit, lowercase hex string. 276 | 277 | =item C 278 | 279 | Integer denoting the Ethernet type field. 280 | 281 | =item C 282 | 283 | Payload data of the Ethernet frame. 284 | 285 | =back 286 | 287 | =cut 288 | 289 | sub encode_ethernet { 290 | my ($self) = @_; 291 | 292 | return pack( 'H12H12na*', @{$self}{qw( dest_mac src_mac type data )} ); 293 | } 294 | 295 | ############################################################################### 296 | 297 | =item XB ( I ) 298 | 299 | Synonymous with L. 300 | 301 | =cut 302 | 303 | sub decode_ip { &decode_ipv4 } 304 | 305 | =item XB ( I ) 306 | 307 | (TCP/IP Illustrated, Volume 1, Section 3.2, p34-37.) 308 | 309 | Decode I as a raw IPv4 packet. Returns a hash with the following 310 | fields: 311 | 312 | =over 12 313 | 314 | =item C 315 | 316 | IP version (4, duh). 317 | 318 | =item C 319 | 320 | Header length. 321 | 322 | =item C 323 | 324 | Type of Service. 325 | 326 | =item C 327 | 328 | IP packet length. 329 | 330 | =item C 331 | 332 | IP datagram identification. 333 | 334 | =item C 335 | 336 | Fragment offset. 337 | 338 | =item C 339 | 340 | Time To Live. 341 | 342 | =item C 343 | 344 | IP protocol field. 345 | 346 | =item C 347 | 348 | IP checksum. 349 | 350 | =item C 351 | 352 | Source IP address as an 8 digit, lowercase hex string. 353 | 354 | =item C 355 | 356 | Destination IP address as an 8 digit, lowercase hex string. 357 | 358 | =item C 359 | 360 | IP options field. 361 | 362 | =item C 363 | 364 | Payload data of the IP datagram. 365 | 366 | =back 367 | 368 | =cut 369 | 370 | sub decode_ipv4 { 371 | my ($pkt) = @_; 372 | 373 | return {} if ! defined $pkt; 374 | 375 | my %self; 376 | 377 | # Unpack IP addresses directly as "H8". 378 | ( 379 | my $tmp, 380 | @self{qw(tos len id foffset ttl proto cksum src_ip dest_ip options)} 381 | ) = unpack('CCnnnCCnH8H8a*', $pkt); 382 | 383 | # Extract bit fields 384 | $self{ver} = ($tmp & 0xf0) >> 4; 385 | $self{hlen} = $tmp & 0x0f; 386 | 387 | $self{flags} = $self{foffset} >> 13; 388 | $self{foffset} = ($self{foffset} & 0x1fff) << 3; 389 | 390 | # Decode variable length header options and remaining data in field 391 | 392 | # Option length is number of 32 bit words 393 | my $olen = $self{hlen}*4 - 20; 394 | $olen = 0 if $olen < 0; # Check for bad hlen 395 | 396 | @self{qw(options data)} 397 | = unpack("a${olen}a*", $self{options}); 398 | 399 | return \%self; 400 | } 401 | 402 | ############################################################################### 403 | 404 | =item XB ( I ) 405 | 406 | (TCP/IP Illustrated, Volume 1, Section 4.4, p56-57.) 407 | 408 | Decode I as a raw ARP packet. Returns a hash with the following 409 | fields: 410 | 411 | =over 12 412 | 413 | =item C 414 | 415 | Hardware type field. This routine is only designed for 416 | I<$ARP_HTYPE_ETHERNET>. 417 | 418 | =item C 419 | 420 | Type of protocol address. This routine is only designed for 421 | I<$ARP_PROTO_IPv4>. 422 | 423 | =item C, C 424 | 425 | Hardware address length and protocol address length (in octets). For IPv4 426 | on Ethernet these should be I<$ARP_HLEN_ETHERNET> and I<$ARP_PLEN_IPv4>, 427 | respectively. 428 | 429 | =item C 430 | 431 | Operation type: one of I<$ARP_OPCODE_REQUEST> or I<$ARP_OPCODE_REPLY>. 432 | 433 | =item C 434 | 435 | Source hardware (MAC) address 436 | as a 12 digit, lowercase hex string. 437 | 438 | =item C 439 | 440 | Source protocol (IP) address 441 | as an 8 digit, lowercase hex string. 442 | 443 | =item C 444 | 445 | Target hardware (MAC) address 446 | as a 12 digit, lowercase hex string. 447 | 448 | =item C 449 | 450 | Target protocol (IP) address 451 | as an 8 digit, lowercase hex string. 452 | 453 | =item C 454 | 455 | Payload data (always C) 456 | 457 | =back 458 | 459 | In theory the ARP packet could be for an AppleTalk address over Token Ring, but 460 | in practice (and our use case), we only see IP over Ethernet. 461 | 462 | Still, it pays to check the C and C fields, just to make sure you 463 | don't get nonsense. 464 | 465 | =cut 466 | 467 | sub decode_arp { 468 | my ($pkt) = @_; 469 | return {} if !defined $pkt; 470 | 471 | my %self; 472 | 473 | # @self{qw( htype proto hlen plen opcode sha spa tha tpa )} 474 | # = unpack('nnCCnH12H8H12H8', $pkt); 475 | 476 | # 99 out of 100 times hlen is 6 and plen is 4 (IP over ethernet), 477 | # but just in case: 478 | ( 479 | @self{qw( htype proto hlen plen opcode )}, 480 | my $payload 481 | ) = unpack('nnCCna*', $pkt); 482 | 483 | # Take the long way home. 484 | my $spec = 'H'.($self{hlen}*2).'H'.($self{plen}*2); 485 | @self{qw( sha spa tha tpa )} = unpack($spec.$spec, $payload); 486 | 487 | $self{data} = undef; 488 | return \%self; 489 | } 490 | 491 | ############################################################################### 492 | 493 | =item XB ( I ) 494 | 495 | (TCP/IP Illustrated, Volume 1, Section 4.4, p56-57.) 496 | 497 | Encode I as a raw ARP packet. Returns a scalar with 498 | the raw data. I should point to a hash with the following fields: 499 | 500 | =over 12 501 | 502 | =item C 503 | 504 | (optional, default value I<$ARP_HTYPE_ETHERNET>) 505 | 506 | Hardware type field. Only I<$ARP_HTYPE_ETHERNET> is currently supported. 507 | 508 | =item C 509 | 510 | (optional, default value I<$ARP_PROTO_IPv4>) 511 | 512 | Type of protocol address. Only I<$ARP_PROTO_IPv4> is currently supported. 513 | 514 | =item C, C 515 | 516 | (optional, default values I<$ARP_HLEN_ETHERNET> and I<$ARP_PLEN_IPv4>) 517 | 518 | Hardware address length and protocol address length (in octets). For IPv4 519 | on Ethernet these should be I<$ARP_HLEN_ETHERNET> and I<$ARP_PLEN_IPv4>, 520 | respectively. 521 | 522 | =item C 523 | 524 | Operation type: one of I<$ARP_OPCODE_REQUEST> or I<$ARP_OPCODE_REPLY>. 525 | 526 | =item C 527 | 528 | Source hardware (MAC) address 529 | as a 12 digit, lowercase hex string. 530 | 531 | =item C 532 | 533 | Source protocol (IP) address 534 | as an 8 digit, lowercase hex string. 535 | 536 | =item C 537 | 538 | Target hardware (MAC) address 539 | as a 12 digit, lowercase hex string. 540 | 541 | =item C 542 | 543 | Target protocol (IP) address 544 | as an 8 digit, lowercase hex string. 545 | 546 | =back 547 | 548 | In theory the ARP packet could be for an AppleTalk address over Token Ring, but 549 | in practice (and our use case), we only see IP over Ethernet. 550 | 551 | =cut 552 | 553 | sub encode_arp { 554 | my ($self) = @_; 555 | 556 | $self->{htype} //= $ARP_HTYPE_ETHERNET; 557 | $self->{proto} //= $ARP_PROTO_IPv4; 558 | 559 | $self->{hlen} //= $ARP_HLEN_ETHERNET; 560 | $self->{plen} //= $ARP_PLEN_IPv4; 561 | 562 | my $spec = 'H'.($self->{hlen}*2).'H'.($self->{plen}*2); 563 | return pack("nnCCn$spec$spec", 564 | @{$self}{qw( htype proto hlen plen opcode sha spa tha tpa )} 565 | ); 566 | } 567 | 568 | ############################################################################### 569 | 570 | 1; 571 | 572 | __END__ 573 | 574 | =back 575 | 576 | =head1 EXAMPLE 577 | 578 | See the L section. 579 | 580 | =head1 SEE ALSO 581 | 582 | L, 583 | L, 584 | L. 585 | 586 | =head1 AUTHORS 587 | 588 | Steven Bakker at AMS-IX (steven.bakker@ams-ix.net). 589 | 590 | =head1 COPYRIGHT 591 | 592 | Copyright 2011-2016, AMS-IX B.V. 593 | Distributed under GPL and the Artistic License 2.0. 594 | 595 | =cut 596 | -------------------------------------------------------------------------------- /lib/M6/ArpSponge/Util.pm: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # 3 | # ARP Stuff Utility routines 4 | # 5 | # Copyright 2005-2016 AMS-IX B.V.; All rights reserved. 6 | # 7 | # This module is free software; you can redistribute it and/or 8 | # modify it under the same terms as Perl itself. See perldoc 9 | # perlartistic. 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. 14 | # 15 | # See the "Copying" file that came with this package. 16 | # 17 | # S.Bakker. 18 | # 19 | ############################################################################### 20 | package M6::ArpSponge::Util; 21 | 22 | use strict; 23 | use POSIX qw( strftime strtod strtol ); 24 | use NetAddr::IP; 25 | 26 | BEGIN { 27 | use Exporter; 28 | 29 | our $VERSION = 1.04; 30 | our @ISA = qw( Exporter ); 31 | 32 | our @EXPORT_OK = qw( 33 | int2ip ip2int hex2ip ip2hex hex2mac mac2hex mac2mac 34 | format_time relative_time hex_addr_in_net 35 | is_valid_int is_valid_float is_valid_ip 36 | is_valid_bool 37 | arpflags2int int2arpflags 38 | ); 39 | our @EXPORT = (); 40 | 41 | our %EXPORT_TAGS = ( 42 | 'all' => \@EXPORT_OK 43 | ); 44 | } 45 | 46 | =pod 47 | 48 | =head1 NAME 49 | 50 | M6::ArpSponge::Util - IP, MAC, misc. utility routines 51 | 52 | =head1 SYNOPSIS 53 | 54 | use M6::ArpSponge::Util qw( :all ); 55 | 56 | $ip = int2ip( $num ); 57 | $num = ip2int( $ip ); 58 | $ip = hex2ip( $hex ); 59 | $hex = ip2hex( $ip ); 60 | $mac = hex2mac( $hex ); 61 | $hex = mac2hex( $mac ); 62 | $mac = mac2mac( $mac ); 63 | 64 | $str = format_time($some_earlier_time); 65 | $str = relative_time($some_earlier_time); 66 | 67 | $in_net = hex_addr_in_net($hex, $hexnet, $prefixlen ); 68 | 69 | $month = is_valid_int($some_string, -min=>1, -max=>12); 70 | $count = is_valid_int($some_string, -min=>0); 71 | 72 | $chance = is_valid_float($some_string, -min=>0, -max=>1, -inclusive=>1); 73 | 74 | $ip_string = is_valid_ip($some_string, -network=>'192.168.1.0/24'); 75 | 76 | $bool = is_valid_bool($some_expr); 77 | 78 | =head1 DESCRIPTION 79 | 80 | This module defines a number of routines to convert IP and MAC 81 | representations to and from various formats and some miscellaneous 82 | utility functions. 83 | 84 | =head1 FUNCTIONS 85 | 86 | =over 87 | 88 | =cut 89 | 90 | ############################################################################### 91 | 92 | =item XB ( I ) 93 | 94 | Convert a (long) integer to a dotted decimal IP address. Return the 95 | dotted decimal string. 96 | 97 | Example: int2ip(3250751620) returns "193.194.136.132". 98 | 99 | =cut 100 | 101 | sub int2ip { 102 | hex2ip(sprintf("%08x", $_[0])); 103 | }; 104 | 105 | ############################################################################### 106 | 107 | =item XB ( I ) 108 | 109 | Dotted decimal IPv4 address to integer representation. 110 | 111 | Example: ip2int("193.194.136.132") returns "3250751620". 112 | 113 | =cut 114 | 115 | sub ip2int { 116 | hex(ip2hex($_[0])); 117 | }; 118 | 119 | ############################################################################### 120 | 121 | =item XB ( I ) 122 | 123 | Hexadecimal IPv4 address to dotted decimal representation. 124 | 125 | Example: hex2ip("c1c28884") returns "193.194.136.132". 126 | 127 | =cut 128 | 129 | sub hex2ip { 130 | my ($hex) = @_; 131 | 132 | $hex =~ /(..)(..)(..)(..)/; 133 | my $ip = sprintf("%d.%d.%d.%d", hex($1), hex($2), hex($3), hex($4)); 134 | return $ip; 135 | }; 136 | 137 | ############################################################################### 138 | 139 | =item XB ( I ) 140 | 141 | Dotted decimal IPv4 address to hex representation. 142 | 143 | Example: ip2hex("193.194.136.132") 144 | returns "c1c28884". 145 | 146 | =cut 147 | 148 | sub ip2hex { 149 | return sprintf("%02x%02x%02x%02x", split(/\./, $_[0])); 150 | }; 151 | 152 | ############################################################################### 153 | 154 | =item XB ( I ) 155 | 156 | Hexadecimal MAC address to colon-separated hex representation. 157 | 158 | Example: hex2mac("a1b20304e5f6") 159 | returns "a1:b2:03:04:e5:f6" 160 | 161 | =cut 162 | 163 | sub hex2mac { 164 | my $hex = substr("000000000000$_[0]", -12); 165 | $hex =~ /(..)(..)(..)(..)(..)(..)/; 166 | return sprintf("%02x:%02x:%02x:%02x:%02x:%02x", 167 | hex($1), hex($2), hex($3), hex($4), hex($5), hex($6)); 168 | }; 169 | 170 | ############################################################################### 171 | 172 | =item XB ( I ) 173 | 174 | Any MAC address to hex representation. 175 | 176 | Example: 177 | mac2hex("a1:b2:3:4:e5:f6") 178 | returns "a1b20304e5f6". 179 | 180 | =cut 181 | 182 | sub mac2hex { 183 | return if !@_ or !defined $_[0]; 184 | my @mac = split(/[\s\.\-:\-]/, $_[0]); 185 | return undef if 12 % int(@mac); 186 | my $digits = int(12 / int(@mac)); 187 | my $hex; 188 | my $pref = '000000000000'; 189 | foreach my $grp (@mac) { $hex .= substr($pref.$grp, -$digits) } 190 | return lc $hex; 191 | }; 192 | 193 | ############################################################################### 194 | 195 | =item XB ( I ) 196 | 197 | Any MAC address to colon-separated hex representation (6 groups of 2 digits). 198 | 199 | Example: mac2mac("a1b2.304.e5f6") 200 | returns "a1:b2:03:04:e5:f6" 201 | 202 | =cut 203 | 204 | sub mac2mac { 205 | hex2mac(mac2hex($_[0])); 206 | } 207 | 208 | ############################################################################### 209 | 210 | =item XB ( I, I, I ) 211 | 212 | Check whether I is a part of I/I. The 213 | I and I parameters are IP addresses in hexadecimal 214 | notation. 215 | 216 | Returns 1 if I is part of I/I, C otherwise. 217 | 218 | =cut 219 | 220 | sub hex_addr_in_net { 221 | my ($addr, $net, $len) = @_; 222 | 223 | my $nibbles = $len >> 2; 224 | 225 | #print STDERR "$nibbles nibbles\n"; 226 | 227 | if ($nibbles) { 228 | if (substr($addr, 0, $nibbles) ne substr($net, 0, $nibbles)) { 229 | return; 230 | } 231 | } 232 | 233 | $len = $len % 4; 234 | 235 | #print STDERR "$len bits leftover\n"; 236 | return 1 if !$len; 237 | 238 | #my $mask = 0xf & ~( 1<<(4-$len) - 1 ); 239 | my $mask = (0,8,12,14,15)[$len]; 240 | my $addr_nibble = hex(substr($addr, $nibbles, 1)); 241 | my $net_nibble = hex(substr($net, $nibbles, 1)); 242 | #print STDERR "addr:$addr_nibble net:$net_nibble mask:$mask\n"; 243 | return ($addr_nibble & $mask) == $net_nibble; 244 | } 245 | 246 | ############################################################################### 247 | 248 | =item XB ( I 249 | [, B<-min> =E I, B<-max> =E I, 250 | B<-inclusive> =E I, 251 | B<-err> =E I ] ) 252 | 253 | Check whether I is defined and represents a valid integer. If I 254 | and/or I are given and not C, it also checks the boundaries 255 | (by default inclusive). Returns the integer value if the checks are successful, 256 | C otherwise. 257 | 258 | If an error occurs, and C<-err> is specified, the scalar behind I will 259 | contain a diagnostic. 260 | 261 | Example: 262 | 263 | =over 264 | 265 | =item Check for a positive integer: 266 | 267 | # check for >= 1 268 | if ($val = is_valid_int($arg, -min => 1)) { 269 | ... 270 | } 271 | 272 | # check for > 0 273 | if ($val = is_valid_int($arg, -min => 0, -inclusive => 0)) { 274 | ... 275 | } 276 | 277 | 278 | =item Check for a negative integer: 279 | 280 | if ($val = is_valid_int($arg, -max => -1)) { 281 | ... 282 | } 283 | 284 | =item Check for a valid month number: 285 | 286 | if ($val = is_valid_int($arg, -min => 1, -max => 12)) { 287 | ... 288 | } 289 | 290 | =back 291 | 292 | =cut 293 | 294 | sub is_valid_int { 295 | my ($arg, @opt) = @_; 296 | my $err_s; 297 | my %opts = ( 298 | -err => \$err_s, 299 | -min => undef, 300 | -max => undef, 301 | -inclusive => 1, 302 | @opt, 303 | ); 304 | 305 | if (!defined $arg || length($arg) == 0) { 306 | ${$opts{-err}} = 'not a valid number'; 307 | return; 308 | } 309 | 310 | my ($num, $unparsed) = strtol($arg); 311 | if ($unparsed) { 312 | ${$opts{-err}} = 'not a valid number'; 313 | return; 314 | } 315 | 316 | if (defined(my $min = $opts{-min})) { 317 | my $min_ok = $opts{-inclusive} ? $num >= $min : $num > $min; 318 | if (!$min_ok) { 319 | ${$opts{-err}} = 'number too small'; 320 | return; 321 | } 322 | } 323 | if (defined(my $max = $opts{-max})) { 324 | my $max_ok = $opts{-inclusive} ? $num <= $max : $num < $max; 325 | if (!$max_ok) { 326 | ${$opts{-err}} = 'number too larg'; 327 | return; 328 | } 329 | } 330 | 331 | ${$opts{-err}} = ''; 332 | return $num; 333 | } 334 | 335 | ############################################################################### 336 | 337 | =item XB ( I 338 | [, B<-min> =E I, B<-max> =E I, 339 | B<-inclusive> =E I, 340 | B<-err> =E I ] ) 341 | 342 | Check whether I is defined and represents a valid floating point 343 | number. If I and/or I are given and not C, it also 344 | checks the boundaries (by default inclusive). Returns the value of I 345 | if the checks are successful, C otherwise. 346 | 347 | If an error occurs, and C<-err> is specified, the scalar behind I will 348 | contain a diagnostic. 349 | 350 | Example: 351 | 352 | =over 353 | 354 | =item Check for a positive float: 355 | 356 | # check for > 0 357 | if ($val = is_valid_float($arg, -min => 0, -inclusive => 0)) { 358 | ... 359 | } 360 | 361 | 362 | =item Check for a negative float: 363 | 364 | if ($val = is_valid_float($arg, -max => 0, -inclusive => 0)) { 365 | ... 366 | } 367 | 368 | =item Check for a valid stochastic value: 369 | 370 | if ($val = is_valid_float($arg, -min => 0, -max => 1)) { 371 | ... 372 | } 373 | 374 | =back 375 | 376 | =cut 377 | 378 | sub is_valid_float { 379 | my ($arg, @opt) = @_; 380 | my $err_s; 381 | my %opts = ( 382 | -err => \$err_s, 383 | -min => undef, 384 | -max => undef, 385 | -inclusive => 1, 386 | @opt, 387 | ); 388 | 389 | if (!defined $arg || length($arg) == 0) { 390 | ${$opts{-err}} = 'not a valid number'; 391 | return; 392 | } 393 | 394 | my ($num, $unparsed) = strtod($arg); 395 | if ($unparsed) { 396 | ${$opts{-err}} = 'not a valid number'; 397 | return; 398 | } 399 | 400 | if (defined(my $min = $opts{-min})) { 401 | my $min_ok = $opts{-inclusive} ? $num >= $min : $num > $min; 402 | if (!$min_ok) { 403 | ${$opts{-err}} = 'number too small'; 404 | return; 405 | } 406 | } 407 | if (defined(my $max = $opts{-max})) { 408 | my $max_ok = $opts{-inclusive} ? $num <= $max : $num < $max; 409 | if (!$max_ok) { 410 | ${$opts{-err}} = 'number too larg'; 411 | return; 412 | } 413 | } 414 | 415 | ${$opts{-err}} = ''; 416 | return $num; 417 | } 418 | 419 | ############################################################################### 420 | 421 | =item B ( I [, -err => I ] ) 422 | X 423 | 424 | Check whether I is defined and represents a valid boolean value. 425 | Acceptable values are: 426 | 427 | =over 428 | 429 | =item I: 430 | 431 | C, C, C, I 0>. 432 | 433 | =item I: 434 | 435 | C, C, C, I= 0>. 436 | 437 | =back 438 | 439 | Returns C<1> for I, C<0> for I, or I on error. 440 | 441 | If an error occurs, and C<-err> is specified, the scalar behind I will 442 | contain a diagnostic. 443 | 444 | =cut 445 | 446 | sub is_valid_bool { 447 | my ($arg, @opt) = @_; 448 | my $err_s; 449 | my %opts = (-err => \$err_s, @opt); 450 | 451 | if (!defined $arg || length($arg) == 0) { 452 | ${$opts{-err}} = q/not a valid boolean/; 453 | return; 454 | } 455 | 456 | if ($arg =~ /^(?:[+-]?)\d+$/) { 457 | return int($arg)>0 ? 1 : 0; 458 | } 459 | 460 | return 1 if $arg =~ /^true|yes|on$/i; 461 | return 0 if $arg =~ /^false|no|off$/i; 462 | 463 | ${$opts{-err}} = qq/not a valid boolean/; 464 | return; 465 | } 466 | 467 | ############################################################################### 468 | 469 | =item B ( I 470 | [, B<-network> =E I] 471 | [, B<-err> =E I] 472 | ) 473 | X 474 | 475 | Check whether I is defined and represents a valid IPv4 address. 476 | If I is given, it also checks whether the address is part 477 | of I. Returns the value of I if the checks are successful, 478 | C otherwise. 479 | 480 | If an error occurs, and C<-err> is specified, the scalar behind I will 481 | contain a diagnostic. 482 | 483 | =cut 484 | 485 | sub is_valid_ip { 486 | my ($arg, @opt) = @_; 487 | my $err_s; 488 | my %opts = (-err => \$err_s, -network => undef, @opt); 489 | 490 | if (!defined $arg || length($arg) == 0) { 491 | ${$opts{-err}} = q/"" is not a valid IPv4 address/; 492 | return; 493 | } 494 | 495 | my $ip = $arg =~ /^\d/ ? NetAddr::IP->new($arg) : undef; 496 | if (!$ip) { 497 | ${$opts{-err}} = qq/"$arg" is not a valid IPv4 address/; 498 | return; 499 | } 500 | 501 | return $ip->addr() if !$opts{-network}; 502 | 503 | if (my $net = NetAddr::IP->new($opts{-network})) { 504 | return $ip->addr() if $net->contains($ip); 505 | ${$opts{-err}} = qq/$arg is out of range /.$net->cidr(); 506 | return; 507 | } 508 | ${$opts{-err}} = qq/** INTERNAL ** is_valid_ip(): -network / 509 | . qq/argument "$opts{-network}" is not valid/; 510 | warn ${$opts{-err}}; 511 | return; 512 | } 513 | 514 | ############################################################################### 515 | 516 | =item XB ( I