ircl.pl 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use Config::IniFiles;
  5. use Encode;
  6. use IO::Select;
  7. use IO::Socket::SSL;
  8. use Socket;
  9. use Term::ANSIColor;
  10. my $VERSION = 'ircl-0.04a';
  11. my $NOPRINT_REGEX = '[\x{00}-\x{08}\x{0B}\x{0C}\x{0E}-\x{1F}]';
  12. my @UID_TABLE = ("A".."F", 0..9);
  13. my $NUMUID;
  14. my $LAST_UID = '';
  15. my %LUSERINFO = ();
  16. my $CONFFILE = $ENV{BASEPATH} . '/muh.conf';
  17. my %CONF = (
  18. connect => {
  19. host => undef,
  20. port => undef,
  21. ssl => undef,
  22. sslverify => undef,
  23. timeout => undef,
  24. },
  25. irc => {
  26. linkname => undef,
  27. hub => undef,
  28. sid => undef,
  29. password => undef,
  30. netinfo => undef,
  31. proto => undef,
  32. timeout => undef,
  33. },
  34. user => {
  35. nick => undef,
  36. ident => undef,
  37. host => undef,
  38. gecos => undef,
  39. umodes => undef,
  40. snomask => undef,
  41. channels => [],
  42. },
  43. );
  44. my %LIMITS = (
  45. nick => 30,
  46. ident => 10,
  47. channel => 32,
  48. kick => 307,
  49. topic => 307,
  50. host => 128,
  51. );
  52. my $GOTINT = 0;
  53. my $IRCSOCK = undef;
  54. my $SOCKDRAWER = undef;
  55. sub next_uid {
  56. use integer;
  57. my $uid = '';
  58. my $num = $NUMUID++;
  59. for(1..6) {
  60. $uid = $UID_TABLE[$num % 36] . $uid;
  61. $num /= 36;
  62. }
  63. if($num) {
  64. printem('-- We ran out of UIDs (did you fucking have 2 billion users somehow?), bailing the fuck out', "\r\n");
  65. sendem(':<SID> SQUIT <LNAME> :RIP all mein UIDs');
  66. eval { $IRCSOCK->close; };
  67. exit 1;
  68. }
  69. $LAST_UID = $CONF{irc}->{sid} . $uid;
  70. return $LAST_UID;
  71. }
  72. sub appenduser {
  73. my ($nicc, $ident, $host, $gecos) = @_;
  74. return if(!defined($nicc) || $nicc !~ /^[A-Za-z0-9]{1,$LIMITS{nick}}$/);
  75. return if(!defined($ident) || $ident !~ /^[A-Za-z0-9]{1,$LIMITS{ident}}$/);
  76. return if(!defined($host) || $host !~ /^[A-Za-z0-9_.\-]{1,$LIMITS{host}}$/);
  77. return if(!defined($gecos) || $gecos =~ /^\s*$/);
  78. my $tiem = time;
  79. my $lcnicc = lc($nicc);
  80. return if(exists($LUSERINFO{$lcnicc}));
  81. $LUSERINFO{$lcnicc} = {
  82. orignick => $nicc,
  83. ident => $ident,
  84. host => $host,
  85. gecos => $gecos,
  86. uid => next_uid,
  87. signon => $tiem,
  88. lastseen => $tiem,
  89. idle => 0,
  90. };
  91. }
  92. sub setidle {
  93. my $nicc = $CONF{user}->{nick};
  94. my $lcnicc = lc($nicc);
  95. return if(!exists($LUSERINFO{$lcnicc}));
  96. $LUSERINFO{$lcnicc}->{lastseen} = time;
  97. $LUSERINFO{$lcnicc}->{idle} = 0;
  98. }
  99. sub run_conf {
  100. my $cfg = Config::IniFiles->new(-file => $CONFFILE, -handle_trailing_comment => 1, -commentchar => ';', -allowedcommentchars => ';');
  101. my $wegood = 1;
  102. if(!$cfg) {
  103. printem("-- Unable to open file '$CONFFILE' for reading");
  104. exit 1;
  105. }
  106. printem('*** Parsing config...');
  107. foreach my $section(sort(keys(%CONF))) {
  108. foreach my $key(sort(keys(%{$CONF{$section}}))) {
  109. my $val = $cfg->val($section, $key);
  110. if(!defined($val)) {
  111. next if($key =~ /^(channels)$/);
  112. $wegood = 0;
  113. printem("-- Missing value for $section::$key", undef, "\t");
  114. next;
  115. }
  116. $val =~ s/(^\s+|\s+$)//g;
  117. if($val =~ /^\s*$/) {
  118. $wegood = 0;
  119. printem("-- Invalid value '$val' for $section::$key", undef, "\t");
  120. next;
  121. }
  122. if(defined($LIMITS{$key})) {
  123. my $limit = $LIMITS{$key};
  124. if(length($val) > $limit) {
  125. $wegood = 0;
  126. printem("-- Value '$val' for $section::$key is too long ($limit chars max)", undef, "\t");
  127. next;
  128. }
  129. }
  130. if($key eq 'sid' && $val !~ /^[0-9A-F]{3}$/) {
  131. $wegood = 0;
  132. printem("-- Invalid SID '$val' (must be 3 hexadecimal chars, uppercase etc)", undef, "\t");
  133. next;
  134. }
  135. if($key eq 'port' && ($val !~ /^\d{1,5}$/ || $val == 0 || $val > 65535)) {
  136. $wegood = 0;
  137. printem("-- Invalid port '$val' (must be higher than 0 and less than or equal to 65535 fam)", undef, "\t");
  138. next;
  139. }
  140. if($key =~ /^ssl/ && $val !~ /^[01]$/) {
  141. $wegood = 0;
  142. printem("-- Invalid value '$val' for $section::$key (must be either 0 or 1)", undef, "\t");
  143. next;
  144. }
  145. if($key =~ /^(nick|ident)$/ && $val !~ /^[A-Za-z0-9]{1,$LIMITS{$key}}$/) {
  146. $wegood = 0;
  147. printem("-- Invalid value '$val' for $section::$key (must contain only alphanumerical chars -- also between 1 and $LIMITS{$key} chars in length)", undef, "\t");
  148. next;
  149. }
  150. if($section eq 'user' && $key eq 'host' && $val !~ /^[A-Za-z0-9_.\-]{1,$LIMITS{host}}$/) {
  151. $wegood = 0;
  152. printem("-- Invalid value '$val' for $section::$key (must contain only alphanumerical chars and underscores/hyphens/dots -- also between 1 and $LIMITS{$key} chars in length)", undef, "\t");
  153. next;
  154. }
  155. if($key =~ /^(timeout|proto)$/ && $val !~ /^\d+$/) {
  156. $wegood = 0;
  157. printem("-- Invalid value '$val' for $section::$key (must be numerical)", undef, "\t");
  158. next;
  159. }
  160. if($key eq 'channels') {
  161. my @chans = sort(split(/(?:\s+|,)/, $val));
  162. $val = [];
  163. my $badchan = 0;
  164. my $chlimit = $LIMITS{channel} || 32;
  165. foreach my $chan(@chans) {
  166. $chan = "\#$chan" if($chan !~ /^#/);
  167. if(length($chan) > $chlimit) {
  168. $badchan = 1;
  169. $wegood = 0;
  170. printem("-- Channel name '$chan' is too long ($chlimit chars max)", undef, "\t");
  171. next;
  172. }
  173. push(@{$val}, $chan);
  174. }
  175. next if($badchan);
  176. }
  177. if($key eq 'umodes' && $val =~ /s/) {
  178. printem("== Usermode 's' is not necessary ;]", undef, "\t");
  179. $val =~ s/s//;
  180. }
  181. $CONF{$section}->{$key} = $val;
  182. }
  183. }
  184. if(!$wegood) {
  185. printem('-- Config file incomplete or invalid, bailing out lol');
  186. exit 1;
  187. }
  188. }
  189. sub connect_irc {
  190. my $wegood = 0;
  191. my $tiem = time;
  192. if($CONF{connect}->{ssl}) {
  193. $IRCSOCK = IO::Socket::SSL->new(
  194. PeerAddr => $CONF{connect}->{host},
  195. PeerPort => $CONF{connect}->{port},
  196. Proto => 'tcp',
  197. Type => SOCK_STREAM,
  198. SSL_verify_mode => ($CONF{connect}->{sslverify} ? SSL_VERIFY_PEER : SSL_VERIFY_NONE),
  199. );
  200. }
  201. else {
  202. $IRCSOCK = IO::Socket::INET->new(
  203. PeerAddr => $CONF{connect}->{host},
  204. PeerPort => $CONF{connect}->{port},
  205. Proto => 'tcp',
  206. Type => SOCK_STREAM,
  207. );
  208. }
  209. if(!$IRCSOCK) {
  210. printem("-- Cannot connect to the IRC server: $@");
  211. return 0;
  212. }
  213. printem('*** Connected to the server, setting binmode UTF-8 and timeouts ;]');
  214. my $timeout = pack('l!l!', $CONF{irc}->{timeout}, 0);
  215. $IRCSOCK->setsockopt(SOL_SOCKET, SO_RCVTIMEO, $timeout);
  216. $IRCSOCK->autoflush(1);
  217. binmode($IRCSOCK, ':utf8');
  218. IO::Handle::blocking($IRCSOCK, 0);
  219. $SOCKDRAWER = IO::Select->new($IRCSOCK);
  220. my @lines = (
  221. "PASS :$CONF{irc}->{password}",
  222. "PROTOCTL EAUTH=$CONF{irc}->{linkname} SID=$CONF{irc}->{sid} TS=$tiem",
  223. "PROTOCTL NOQUIT NICKv2 SJOIN SJ3 CLK TKLEXT TKLEXT2 NICKIP ESVID MLOCK EXTSWHOIS",
  224. "SERVER $CONF{irc}->{linkname} 1 :U$CONF{irc}->{proto}-h4XeR-900 $VERSION",
  225. "NETINFO 1 $tiem $CONF{irc}->{proto} * 0 0 0 :$CONF{irc}->{netinfo}",
  226. "EOS",
  227. );
  228. foreach my $line(@lines) {
  229. my ($cmd) = $line =~ /^(\w+)/;
  230. my $size = length("$line\r\n");
  231. my $sent = sendem($line);
  232. if($size != $sent) {
  233. printem("-- Sent size mismatch for command '$cmd', bailing out", undef, "\t");
  234. return 0;
  235. }
  236. if($SOCKDRAWER->can_read($CONF{connect}->{timeout})) {
  237. my $response = undef;
  238. if(defined($response = <$IRCSOCK>)) {
  239. $response =~ s/(^\s+|\s+)$//g;
  240. my ($recvcmd) = $response =~ /^(\w+)/;
  241. printem("<< $response");
  242. if($response =~ /^ERROR :/) {
  243. printem('-- Bailing out lol', undef, "\t");
  244. return 0;
  245. }
  246. if(my ($recvpass) = $response =~ /^PASS :(.+)/) {
  247. if($recvpass ne $CONF{irc}->{password}) {
  248. printem('-- Received invalid link password, bailing out', undef, "\t");
  249. return 0;
  250. }
  251. }
  252. if($recvcmd && $recvcmd eq 'SERVER') {
  253. if(my ($srv) = $response =~ /^SERVER ([^\s]+?)\s+/) {
  254. if($srv ne $CONF{irc}->{hub}) {
  255. printem("-- Received invalid SERVER name (expected $CONF{irc}->{hub}), bailing out", undef, "\t");
  256. return 0;
  257. }
  258. $wegood = 1;
  259. }
  260. }
  261. }
  262. if($cmd !~ /^(PASS|PROTOCTL)/ && (!$response || $response =~ /^\s*$/)) {
  263. printem('-- No response from server, bailing out');
  264. return 0;
  265. }
  266. }
  267. }
  268. if(!$wegood) {
  269. printem('-- Incomplete server handshake, bailing out');
  270. return 0;
  271. }
  272. printem('*** Successfully negotiated connection');
  273. return 1;
  274. }
  275. sub irc_loop {
  276. my $toc = 0;
  277. my $data;
  278. my $datalen;
  279. my $timeout = pack('l!l!', 2, 0);
  280. my $ping = 0;
  281. $IRCSOCK->setsockopt(SOL_SOCKET, SO_RCVTIMEO, $timeout);
  282. my $stdinselect = IO::Select->new;
  283. $stdinselect->add(\*STDIN);
  284. while($IRCSOCK) {
  285. $data = '';
  286. $datalen = 0;
  287. if($stdinselect->can_read(0.1)) {
  288. my $stdcomm;
  289. while($stdinselect->can_read(0.1) && (($stdcomm = <STDIN>) =~ /^[\r\n]+$/)) { }
  290. chomp($stdcomm);
  291. sendem($stdcomm, 1);
  292. $toc = 0;
  293. }
  294. if($SOCKDRAWER->can_read(0.1)) {
  295. if(defined($data = $IRCSOCK->getline)) {
  296. eval { $data =~ s/[\r\n]+//g; };
  297. $datalen = length($data);
  298. }
  299. }
  300. $ping++;
  301. if(($ping / 5) >= 30) {
  302. sendem(":<LNAME> PING <LNAME> :<HUB>");
  303. $ping = 0;
  304. }
  305. if($datalen < 3) {
  306. $toc += 0.2;
  307. if($toc >= $CONF{irc}->{timeout}) {
  308. printem("-- $CONF{irc}->{hub} timed out (no response for >= $CONF{irc}->{timeout} seconds), bailing out");
  309. last;
  310. }
  311. next;
  312. }
  313. $toc = 0;
  314. parse_line($data);
  315. }
  316. }
  317. sub gibtiem {
  318. my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime;
  319. my $tiemstampus = sprintf("[%02d/%02d/%04d %02d:%02d:%02d]", $mday, $mon + 1, $year + 1900, $hour, $min, $sec);
  320. return $tiemstampus;
  321. }
  322. sub parse_line {
  323. my $line = shift;
  324. my $line_ascii = $line;
  325. #$line =~ s/[\x00-\x1F]//g;
  326. printem("<< $line");
  327. $line_ascii =~ s/[^\x00-\x7F]//g;
  328. my $hub = $CONF{irc}->{hub};
  329. my $lname = $CONF{irc}->{linkname};
  330. my $nick = $CONF{user}->{nick};
  331. if($line =~ /^ERROR :Closing Link: $lname/) {
  332. eval { $IRCSOCK->close; };
  333. exit 1;
  334. }
  335. elsif($line_ascii =~ /^:$hub SMO o :(?:\([\x00-\x1F]*link[\x00-\x1F]*\) )?(Secure )?[Ll]ink $hub -> $lname.+established/) {
  336. appenduser($CONF{user}->{nick}, $CONF{user}->{ident}, $CONF{user}->{host}, $CONF{user}->{gecos});
  337. sendem(':<SID> UID <NICK> 1 <TIME> <IDENT> <HOST> <UID> 0 +<UMODES> <HOST> <HOST> * :<GECOS>');
  338. sendem(':<UID> MODE <NICK> +s +' . $CONF{user}->{snomask});
  339. foreach my $chan(@{$CONF{user}->{channels}}) {
  340. sendem(":<SID> SJOIN <TIME> $chan +nt :@<UID>");
  341. sendem(":<SID> MODE $chan +o <NICK>");
  342. }
  343. }
  344. elsif($line =~ /^:(.+?) PING (.+?) :(.+)/) {
  345. sendem(":<LNAME> PONG <LNAME> :$1");
  346. }
  347. elsif($line =~ /^:$hub 433 * $nick :Nickname is already in use\./) {
  348. my $newnick = $CONF{user}->{nick} . '_';
  349. $CONF{user}->{nick} = $newnick;
  350. sendem(":<UID> NICK $newnick");
  351. }
  352. elsif($line =~ /^:(.+?) KICK (#.*?) (.+?) :(.+)/) {
  353. if(lc($3) eq lc($CONF{user}->{nick})) {
  354. printem("*** Attempting to rejoin $2", undef, "\t");
  355. sendem(":<UID> JOIN $2");
  356. }
  357. }
  358. elsif($line =~ /:(.+?) WHOIS ([^: ]+)/) {
  359. my $from = $1;
  360. my $target = $2;
  361. my $lctarget = lc($target);
  362. return if(!exists($LUSERINFO{$lctarget}));
  363. my $uinfo = $LUSERINFO{$lctarget};
  364. sendem(":<LNAME> 311 $from $target <IDENT> <HOST> * :<GECOS>");
  365. sendem(":<LNAME> 379 $from $target :is using modes +<UMODES> +<SNOMASK>");
  366. sendem(":<LNAME> 378 $from $target :is connecting from *@<HOST> 127.0.0.1");
  367. sendem(":<LNAME> 307 $from $target :is a registered nick") if($CONF{user}->{umodes} =~ /r/);
  368. sendem(":<LNAME> 319 $from $target :" . join(' ', @{$CONF{user}->{channels}}));
  369. sendem(":<LNAME> 312 $from $target <LNAME> :<NETINFO>");
  370. sendem(":<LNAME> 313 $from $target :is an IRC Operator (H A C K E D) [L M A O]") if($CONF{user}->{umodes} =~ /o/);
  371. sendem(":<LNAME> 671 $from $target :is using a Secure Connection") if($CONF{user}->{umodes} =~ /z/);
  372. sendem(":<LNAME> 317 $from $target <IDLE> <SIGNON> :seconds idle, signon time");
  373. sendem(":<LNAME> 318 $from $target :End of /WHOIS list.");
  374. }
  375. }
  376. sub printem {
  377. my ($line, $nl, $indent) = @_;
  378. my $col = '';
  379. my $end = '';
  380. if($line =~ /^\*+/) {
  381. $col = color('bold');
  382. }
  383. elsif($line =~ /^=+/) {
  384. $col = color('bold white');
  385. }
  386. elsif($line =~ /^\-+/) {
  387. $col = color('red');
  388. }
  389. elsif($line =~ /^\++/) {
  390. $col = color('bright_green');
  391. }
  392. elsif($line =~ /^<+/) {
  393. $col = color('magenta');
  394. }
  395. elsif($line =~ /^>+/) {
  396. $col = color('cyan');
  397. }
  398. $line =~ s/($NOPRINT_REGEX)/sprintf("\\x{%02x}", ord($1));/ge;
  399. $end = color('reset') if($col ne '');
  400. print $nl if($nl);
  401. print $indent if($indent);
  402. print $col . ($indent ? '' : (gibtiem . ' ')) . encode('utf-8', $line) . "$end\r\n";
  403. }
  404. sub muhvars {
  405. my $line = shift || return;
  406. my $uinfo = $LUSERINFO{lc($CONF{user}->{nick})};
  407. my $lname = $CONF{irc}->{linkname};
  408. my $hub = $CONF{irc}->{hub};
  409. my $sid = $CONF{irc}->{sid};
  410. my $netinfo = $CONF{irc}->{netinfo};
  411. my $tiem = time;
  412. my $nick = $CONF{user}->{nick};
  413. my $ident = $CONF{user}->{ident};
  414. my $host = $CONF{user}->{host};
  415. my $gecos = $CONF{user}->{gecos};
  416. my $umodes = $CONF{user}->{umodes};
  417. my $snomask = $CONF{user}->{snomask};
  418. $line =~ s/<LNAME>/$lname/g;
  419. $line =~ s/<HUB>/$hub/g;
  420. $line =~ s/<SID>/$sid/g;
  421. $line =~ s/<(TS)?TI(ME|EM)>/$tiem/g;
  422. $line =~ s/<NICK>/$nick/g;
  423. $line =~ s/<IDENT>/$ident/g;
  424. $line =~ s/<HOST>/$host/g;
  425. $line =~ s/<GECOS>/$gecos/g;
  426. $line =~ s/<UMODES>/$umodes/g;
  427. $line =~ s/<SNOMASK>/$snomask/g;
  428. $line =~ s/<NETINFO>/$netinfo/g;
  429. if($uinfo) {
  430. my $uid = $uinfo->{uid} || next_uid;
  431. my $signon = $uinfo->{signon};
  432. my $idle = ($tiem - $uinfo->{lastseen});
  433. $line =~ s/<UID>/$uid/g;
  434. $line =~ s/<SIGNON>/$signon/g;
  435. $line =~ s/<IDLE>/$idle/g;
  436. }
  437. return $line;
  438. }
  439. sub sendem {
  440. my ($line, $stdin) = @_;
  441. return 0 if(!$line || $line =~ /^\s*$/);
  442. my $sent;
  443. $line =~ s/(^\s+|\s+$)//g;
  444. setidle if($line =~ /<NICK>/);
  445. $line = muhvars($line);
  446. $line =~ s/\\x\{?([0-9A-F]{1,2})\}?/chr(sprintf("%d", hex($1)));/eg;
  447. eval { $sent = $IRCSOCK->syswrite("$line\r\n"); };
  448. if($@) {
  449. printem("-- Got error from socket, bailing out [$@]", "\t");
  450. eval { $IRCSOCK->close; };
  451. exit 1;
  452. }
  453. printem(($stdin ? '++ ' : '>> ') . $line);
  454. return $sent;
  455. }
  456. #===================================================================================
  457. printem('*** Starting up');
  458. run_conf;
  459. printem('*** Conf seems to be dank, tryna connect to IRC nao');
  460. if(!connect_irc) {
  461. eval { $IRCSOCK->close; };
  462. exit 1;
  463. }
  464. printem('*** Entering main lewp =]');
  465. irc_loop;
  466. printem('*** Exiting lol');
  467. eval { $IRCSOCK->send('SQUIT :We dun lol'); };
  468. eval { $IRCSOCK->shutdown(2); };
  469. eval { $IRCSOCK->close; };
  470. BEGIN {
  471. $| = 1;
  472. ($ENV{BASEPATH}) = $0 =~ /(.+)\/.+?$/;
  473. $SIG{INT} = sub {
  474. if($IRCSOCK) {
  475. return if($GOTINT);
  476. $GOTINT = 1;
  477. printem('**** Received SIGINT, attempting to cl0se socket cleanly', "\r\n");
  478. sendem(':<SID> SQUIT <LNAME> :Received SIGINT');
  479. sleep(2);
  480. eval {
  481. $IRCSOCK->shutdown(2);
  482. $IRCSOCK->close;
  483. };
  484. }
  485. exit 0;
  486. };
  487. }