Advertisement
N4rCochaos

Heartbleed Honeypot

Apr 12th, 2014
871
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 2.04 KB | None | 0 0
  1.  
  2.  
  3. Contact:https://twitter.com/N4rCochaos
  4.  
  5.  
  6. #!/usr/bin/perl
  7.  
  8. # hb_honeypot.pl -- a quick 'n dirty honeypot hack for Heartbleed
  9. #
  10. # This Perl script listens on TCP port 443 and responds with completely bogus
  11. # SSL heartbeat responses, unless it detects the start of a byte pattern
  12. # similar to that used in Jared Stafford's (jspenguin@jspenguin.org) demo for
  13. # CVE-2014-0160 'Heartbleed'.
  14. #
  15. # Run as root for the privileged port. Outputs IPs of suspected heartbleed scan
  16. # to the console. Rickrolls scanner in the hex dump.
  17. #
  18. # 8 April 2014
  19. # http://www.glitchwrks.com/
  20. # shouts to binrev
  21.  
  22. use strict;
  23. use warnings;
  24. use IO::Socket;
  25.  
  26. my $sock = new IO::Socket::INET (
  27.                                   LocalPort => '443',
  28.                                   Proto => 'tcp',
  29.                                   Listen => 1,
  30.                                   Reuse => 1,
  31.                                 );
  32.  
  33. die "Could not create socket!" unless $sock;
  34.  
  35. # The "done" bit of the handshake response
  36. my $done = pack ("H*", '16030100010E');
  37.  
  38. # Your message here
  39. my $taunt = "09809*)(*)(76&^%&(*&^7657332         Hi there!                  Your scan has   been logged!                    Have no fear,   this is for     research only --                                We're never gonna give you up,  never gonna let you down!";
  40. my $troll = pack ("H*", ('180301' . sprintf( "%04x", length($taunt))));
  41.  
  42. # main "barf responses into the socket" loop
  43. while (my $client = $sock->accept()) {
  44.   $client->autoflush(1);
  45.  
  46.   my $found = 0;
  47.  
  48.   # read things that look like lines, puke nonsense heartbeat responses until
  49.   # a line that looks like it's from the PoC shows up
  50.   while (<$client>) {
  51.     my $line = unpack("H*", $_);
  52.  
  53.     if ($line =~ /^0034.*/) {
  54.       print $client $done;
  55.       $found = 1;
  56.     } else {
  57.       print $client $troll;
  58.       print $client $taunt;
  59.     }
  60.  
  61.     if ($found == 1) {
  62.       print $client $troll;
  63.       print $client $taunt;
  64.       print $client->peerhost . "\n";
  65.       $found = 0;
  66.     }
  67.   }  
  68. }
  69.  
  70. close($sock);
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement