Category Archives: Perl

All my perl works and related things.

X-Chat Perl Reflex Script

  By blackms | May 11, 2010 - 6:07 pm | Perl
2 Comments

Hi, this plugin allow your X-Chat client to reflex any DCC SEND like mIRC does. We have created this plugin, due to the high number of people that has requested us a plugin to reflex from X-Chat.
Also, my friend Xardax has the idea to make a plugin for KvIRC too, so be patient :)
If yuo have any doubts you can contact us on IRC: irc.darksin.ch :: #linux

#!/usr/bin/perl

use warnings;
use strict;
use Xchat;

my $reflex_nick="";

Xchat::register("Reflexer","1.0","Reflexer Perl Script","");
Xchat::print ("^BScript loaded.");
Xchat::print ("^BPlugin for X-Chat by blackms & Xardax :: #linux \@irc.darksin.ch");
Xchat::print ("^BUsage: /reflex REFLEX_NICK\n^BTo turn reflexing off: /rfx_off");

Xchat::hook_command('reflex',"reflex");
Xchat::hook_command('rfx_off',sub {
                                Xchat::print ("^BReflexing turned off.");
                                $reflex_nick="";
                              }
                   );
Xchat::hook_server("PRIVMSG","ctcpreflex");

sub reflex {
        $reflex_nick = defined $_[0][1] ? $_[0][1] : "";
        Xchat::print("^BReflexing all DCC SEND to: $reflex_nick");
        return Xchat::EAT_ALL;
}

sub ctcpreflex {
        return Xchat::EAT_NONE if ($reflex_nick eq "");
        my $data=$_[1][0];
        if ($data =~ m{\001DCC\sSEND\s(.*)\s(\d+)\s(\d+)\s(\d+)\001}) {
                my ($file,$intip,$port,$length) = ($1,$2,$3,$4);
                Xchat::print ("^BReflexing: $file to $reflex_nick on port: $port, length: $length");
                Xchat::command ("PRIVMSG $reflex_nick :\001DCC SEND $file $intip $port $length\001\n\r");
                return Xchat::EAT_ALL;
        }
        return Xchat::EAT_NONE;
}

Bye :)
 

Simple Perl script to stress apache

  By blackms | April 19, 2010 - 6:23 am | Perl
Leave a comment

I’ve made this to stress this blog a little, and see how many requests could it handle.

#!/usr/bin/perl

use strict;
use LWP::Simple;
use LWP::UserAgent;
use Parallel::ForkManager;

my $pm = new Parallel::ForkManager(3);

for (1 .. 10_000) {
	my $pid = $pm->start and next;
	my $ua = new LWP::UserAgent;
	print "Request $_\n";
	$ua->timeout(120);
	my $url='http://www.rocchi.us/';
	my $request = new HTTP::Request('GET', $url);
	my $response = $ua->request($request);
	my $content = $response->content();
	#print $content;
	$pm->finish;
}

Bye

Send mail with Perl

  By blackms | February 21, 2010 - 8:58 am | Perl
Leave a comment

How to simply send mail in Perl?

I use Email::Simple to send an email in a perl script (many emails), here is an example:

my $sendmail = "/usr/sbin/sendmail -t";
my $email = Email::Simple->create(
     header => [
          From    => 'some@thing.tld',
          To      => 'some@destination.tld',
          Subject => 'Subject of the Message',
      ],
      body => 'Body of the Email',
);

$email->header_set( 'X-Content-Container' => 'bottle/glass' );

open SENDMAIL, "|$sendmail" or die "Cannot open $sendmail: $!";
    print SENDMAIL $email->as_string;
close SENDMAIL;

As we can see, it’s very simple to build a new Email message from scratch, I’m sure that exists a lot of way better than this, but I like Email::Simple :)

Any comment or suggestion is wellcome.

Bye ;)