pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

Perl pastebin - collaborative debugging tool View Help


Posted by SiD on Sun 14 Jun 18:13
report abuse | download | new post

  1. #!/usr/bin/perl
  2.  
  3. package PerlFusion;
  4.  
  5. use strict;
  6. use LWP::UserAgent;
  7. use Digest::MD5 qw(md5_hex);
  8.  
  9. my %pages = (
  10.         'Login'    => "/news.php",
  11.         'Logout'   => "/setuser.php?logout=yes",
  12.         'F_ID'     => "/forum/index.php",
  13.         'Tmp_fid'  => 0,
  14.         'Topic_pt' => "/forum/post.php?action=reply&forum_id=",
  15.         'Thread_n' => "/forum/post.php?action=newthread&forum_id="
  16. );
  17. my @msgs = ("Hi people.", "Just a bot.", "Tell me baby!", "'njoy", "wtf?");
  18. my $test_msg = int(rand(scalar(@msgs)));
  19.  
  20. my $cookie = "";
  21. my $url    = "";
  22.  
  23. sub user_login() {
  24.         my($e,$uri,$uid,$pass) = @_;
  25.         if($e eq "PerlFusion") { $e = $uri; }
  26.         die("user_login(Fusion_Path, User_ID, User_Pass)\n") if(!$pass);
  27.        
  28.         $uri = &parse_host($uri);
  29.  
  30.         if($uri =~ /(http|www.)/) {
  31.                 $url = $uri;
  32.                 &request($uid,$pass,'Login');
  33.         }
  34. }
  35.  
  36. sub new_post() {
  37.         my($e,$forum,$thread,$message) = @_;
  38.         if($e eq "PerlFusion") { $e = $forum; }
  39.         $forum = &forumid($forum,$thread);
  40.         my @forum = split("fusion", $forum);
  41.  
  42.         my $lwpt = LWP::UserAgent->new();
  43.         $lwpt->default_header(
  44.                 "Cookie" => $cookie
  45.         );
  46.         my $heads = [
  47.                 message   => $message,
  48.                 postreply => "postreply"
  49.         ];
  50.         my $reqt = $lwpt->post($url.$pages{'Topic_pt'}.@forum[0]."&thread_id=".@forum[1],$heads);
  51.         print "[+] Done.\n";
  52. }
  53.  
  54. sub new_topic() {
  55.         my($e,$forum,$name,$message) = @_;
  56.         if($e eq "PerlFusion") { $e = $forum; }
  57.  
  58.         $forum = &forumid($forum,"",1);
  59.  
  60.         my $lwpn = LWP::UserAgent->new();
  61.         $lwpn->default_header(
  62.                 "Cookie" => $cookie
  63.         );
  64.         my $heads = [
  65.                 subject       => $name,
  66.                 message       => $message,
  67.                 postnewthread => "postnewthread"
  68.         ];
  69.         my $reqn = $lwpn->post($url.$pages{'Thread_n'}.$forum,$heads);
  70.         print "[+] Done.\n";
  71. }
  72.  
  73. sub user_logout() {
  74.         &request('Logout');
  75.         $cookie = "fusion_visited=yes";
  76. }
  77.  
  78. sub forumid() {
  79.         my $fname = shift;
  80.         my $tname = shift;
  81.         my $delim = shift;
  82.         my $toget = &request('F_ID');
  83.         if(
  84.                 $toget =~ /<a href='viewforum.php\?forum_id=(.*?)'>$fname<\/a>/ ||
  85.                 $toget =~ /<a href='viewforum.php\?forum_id=(.*?)'><strong>$fname<\/strong><\/a>/
  86.         ) {
  87.                 $pages{'Tmp_fid'} = "/forum/viewforum.php\?forum_id=".$1; my $thid = $1;
  88.                 my $ntoget = &request('Tmp_fid');
  89.                 if(
  90.                         $ntoget =~ /<a href='viewthread.php\?thread_id=(.*?)'>$tname<\/a>/ ||
  91.                         $ntoget =~ /<a href='viewthread.php\?forum_id=$thid&amp;thread_id=(.*?)'>$tname<\/a>/ ||
  92.                         $ntoget =~ /<a href='viewthread.php\?forum_id=$thid\&thread_id=(.*?)'>$tname<\/a>/
  93.                 ) { return $thid."fusion".$1; }
  94.                 else {
  95.                         die("[-] Topic ID not received.\n") if(!$delim);
  96.                         return $thid if($delim == 1);
  97.                 }
  98.         }
  99.         else {
  100.                 die("[-] Forum ID not received.\n");
  101.         }
  102. }
  103.  
  104. sub request() {
  105.         my($uid,$pass,$what) = @_;
  106.  
  107.         if($uid && $pass) {
  108.                 my $md5p = md5_hex($pass);
  109.                 $cookie = "fusion_visited=yes; fusion_user=".$uid.".".$md5p;
  110.         }
  111.         else {
  112.                 $what = $uid;
  113.         }
  114.         my $lwp = LWP::UserAgent->new();
  115.        
  116.         $lwp->default_header(
  117.                 "Cookie" => $cookie
  118.         );
  119.         my $req = $lwp->post($url.$pages{$what});
  120.         if($req->content !~ /(>edit profile|>modifica profilo|>logout|>logging out)/i) {
  121.                 die("[-] Invalid user id or password.\n");
  122.         }
  123.         return $req->content();
  124. }
  125.  
  126. sub parse_host() {
  127.         my $uri = shift;
  128.  
  129.         my @tmp = split("", $uri);
  130.         if(@tmp[length($uri)-1] eq "/") {
  131.                 @tmp[length($uri)-1] = "";
  132.         }
  133.         $uri = "";
  134.         foreach my $swift(@tmp) {
  135.                 $uri .= $swift;
  136.         }
  137.  
  138.         return $uri;
  139. }
  140.  
  141. 1;

Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.

Syntax highlighting:

To highlight particular lines, prefix each line with @@


Remember me so that I can delete my post