src/utils/scripts/kadnodescreate.pl

   1 #!/usr/bin/perl
   2 #
   3
   4 ## This file is part of the aMule Project
   5 ##
   6 ## Copyright (c) 2004-2008 Angel Vidal ( kry@amule.org )
   7 ## Copyright (c) 2006-2008 aMule Project     ( http://www.amule-project.net )
   8 ##
   9 ## This program is free software; you can redistribute it and/or
  10 ## modify it under the terms of the GNU General Public License
  11 ## as published by the Free Software Foundation; either
  12 ## version 2 of the License, or (at your option) any later version.
  13 ##
  14 ## This program is distributed in the hope that it will be useful,
  15 ## but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ## GNU General Public License for more details.
  18 ##
  19 ## You should have received a copy of the GNU General Public License
  20 ## along with this program; if not, write to the Free Software
  21 ## Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301, USA
  22
  23 use File::Copy;
  24 use warnings;
  25 use strict;
  26
  27 my $exit_with_help;
  28
  29 if (!($ARGV[0])) {
  30         print "You must specify at least one ip.\n";
  31         $exit_with_help = "true";
  32 }
  33
  34 if ($exit_with_help) {
  35         die "Usage: kadnodescreate.pl [hash:ip:TCPport:UDPport:type]+\n";
  36 }
  37
  38
  39 print "Creating nodes.dat...\n";
  40
  41 #Open the new file
  42 open(MET," > nodes.dat");
  43 binmode MET;
  44
  45 my $contactcount = $#ARGV + 1;
  46
  47 print "\tContacts: " . $contactcount . "\n";
  48
  49 print MET &int32_string($contactcount);
  50
  51 my $contact;
  52 my $hash;
  53 my $ip;
  54 my $tcpport;
  55 my $udpport;
  56 my $type;
  57
  58 my $contactnumber = 0;
  59 foreach $contact (@ARGV) {
  60         $contactnumber++;
  61         if ($contact =~ /^(.*):(.*):(.*):(.*):(.*)$/) {
  62
  63                 $hash = &check_hash($1);
  64                 if ($hash == 0) {
  65                         die "Malformed hash, can't continue: " . $1 . "\n";
  66                 }
  67
  68                 $ip = &check_ip($2);
  69                 if ($ip == 0) {
  70                         die "Malformed ip, can't continue: " . $2 . "\n";
  71                 }
  72
  73                 my $tcpport = &check_port($3);
  74                 if ($tcpport == 0) {
  75                         die "Malformed tcp port, can't continue: " . $3 . "\n";
  76                 }
  77
  78                 $udpport = &check_port($4);
  79                 if ($udpport == 0) {
  80                         die "Malformed udp port, can't continue: " . $4 . "\n";
  81                 }
  82
  83                 $type = &check_type($5);
  84                 if ($type == 9) {
  85                         die "Malformed contact type, can't continue: " . $5 . "\n";
  86                 }
  87
  88
  89                 print "\t\tAdding Contact " . $contactnumber . ":\n";
  90                 print "\t\t\tHash    : " . $1 . "\n";
  91                 print "\t\t\tIP      : " . $ip . "\n";
  92                 print "\t\t\tTCPPort : " . $tcpport . "\n";
  93                 print "\t\t\tUDPPort : " . $udpport . "\n";
  94                 print "\t\t\tType    : " . $type . "\n";
  95
  96                 print MET       &hash_string($1) .
  97                                 &int32_string($ip) .
  98                                 &int16_string($tcpport) .
  99                                 &int16_string($udpport) .
 100                                 &byte_string($type);
 101         } else {
 102                 die "Malformed contact line, can't continue: " . $contact . "\n";
 103         }
 104 }
 105
 106 print "Closing nodes.dat\n\n";
 107 close(MET);
 108
 109
 110 # Functions
 111
 112 sub check_ip {
 113         my $ipresult = 0;
 114         if ($_[0] =~ /^([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})$/) {
 115                 $ipresult = ($1*16777216) + ($2*65536) + ($3*256) + $4;
 116         }
 117         $ipresult;
 118 }
 119
 120 sub check_port {
 121         my $portresult = 0;
 122         if ($_[0] =~ /^([0-9]{1,5})$/) {
 123                 if ($1 < 65535) {
 124                         $portresult = $1;
 125                 }
 126         }
 127         $portresult;
 128 }
 129
 130 sub check_type {
 131         my $typeresult = -1;
 132         if ($_[0] =~ /^([0-9])$/) {
 133                 $typeresult = $1;
 134         }
 135         $typeresult;
 136 }
 137
 138 sub check_hash {
 139         my $hashresult = 0;
 140         if ($_[0] =~ /^([A-Z]|[0-9]|[a-z]){32}$/) {
 141                 $hashresult = 1;
 142         }
 143         $hashresult;
 144 }
 145
 146 #Hex write functions
 147
 148 sub byte_string {
 149         sprintf("%c",$_[0]);
 150 }
 151
 152 sub int16_string {
 153         &byte_string($_[0] % 256) . &byte_string($_[0] / 256);
 154 }
 155
 156 sub int32_string {
 157         &int16_string($_[0] % 65536) . &int16_string($_[0] / 65536);
 158 }
 159
 160 sub int64_string {
 161         &int32_string($_[0] % 4294967296) . &int32_string($_[0] / 4294967296);
 162 }
 163
 164 sub hash_string {
 165         my $i = 0;
 166         my $final_string = "";
 167         while ($i < 32) {
 168                 $final_string = $final_string . &byte_string(hex(substr($_[0],$i,2)));
 169                 $i += 2;
 170         }
 171         $final_string;
 172 }
 173