Servidor BBS

Publicado por Carcarah do Sertão Agreste 07/07/2004

[ Hits: 7.245 ]

Download servidor.pl




Servidor Telnet/BBS para iniciantes. AVISO: NÃO É SEGURO!
Por motivos de segurança, não aconselho sua utilização para máquinas com acesso à internet. Ele não possui nenhum recurso contra invasões(como criptografia). Mas é um ótimo exemplo para quem quer se familiarizar com as técnicas de programação para rede. Utiliza IO::Socket.

  



Esconder código-fonte

#!/usr/bin/perl

############ INFO ###########
### Autor: Carcarah
### Email: [email protected]
### AVISO: NÃO MODIFIQUE ESTE CABECALHO
#############################

### A finalidade deste script é mostrar como fazer um servidor telnet simples.
### Lembra das BBS?! Então...

use IO::Socket;
use Net::hostent;


  # Globais
  $versao = "300878-THC";      # loucura
  $operador = "Lucas Almeida";   # hmmm
  $meunome = "Agreste BBS";      # disdrobo
  $porta = 9000;            # porta (sock)
  $EOL = "{FONTE}15{FONTE}12";          # caracteres para fim de linha

  @comandos = (
    '===============',
    '+ sair','+ logoff','+ quem','+ alguem',
    '+ netstat','+ sysop','+ motd','+ data',
    '+ hora','+ arp','+ route','+ id','+ ps',
    '==============='
  );  
  @msg_erro = (
    'Stultorum...',
    'Carpe noctem','Hein?','Ad hoc',
    'Hmmm...','Le petit maurice','Blah!','Ei... Voce...',
    'Digite ?','Sr. Tempo Bom...'    
  );
  
  ##################################
  # configura servidor
  $servidor = IO::Socket::INET->new(
   Proto => 'tcp', 
   LocalPort => $porta, 
   Listen => SOMAXCONN, 
   Reuse => 1
  );
  sub msgerro {
    srand(time());
    $n = rand(@msg_erro);
    return $n;
  }
  
  sub limpa {
    for($a=0;$a<25;$a++) {
   print $cliente $EOL;
    }
  }
  sub ajuda {
    print $cliente ":: Comandos ::$EOL";
   for($cl=0;$cl<@comandos;$cl++) {
       print $cliente @comandos[$cl]."$EOL";
   }
  }
  sub shell {
    print $cliente "$EOL";
    print $cliente "::> ";
  }
  ###################################
    # cabecalho  
    printf "[Servidor iniciado em : %s]\n", scalar localtime;
       
    # aceitou? receba!
    while($cliente = $servidor->accept()) {
   $cliente->autoflush(1);
   $h = getpeername($cliente);
   ($pt,$ia) = unpack_sockaddr_in($h);
   $hi = inet_ntoa($ia);

   $info_host = gethostbyaddr($cliente->peeraddr);
   
   &limpa;
   
   print $cliente ":: Bem-vindo(a) a $meunome ::";
   print $cliente ":: Digite ? para listagem de comandos :: $EOL$EOL";
   printf "[Conexao de %s : %s]\n", $hi, scalar localtime;
   print $cliente "::> ";
     
   while(<$cliente>)
   {
       $errado = 1;
       if (/sair|logoff/i) {
      $errado = 0; 
      print $cliente "Tchau! Volte sempre!$EOL";
      close $cliente;
       }

       if (/data|hora/i) {
      $errado = 0; 
      printf $cliente "%s\n", scalar localtime;    
       }

       if (/quem|alguem/i) { 
          $errado = 0;
      print $cliente `who 2>&1`;               }
       
       if (/motd/i) { 
      $errado = 0;
      print $cliente `cat msg.txt 2>&1`;             }
       
       if (/sysop/i) { 
      $errado = 0;
      print $cliente "Operador: $operador\n";
       }

       if (/netstat/i) { 
      $errado = 0;
      print $cliente `netstat -na | grep EST 2>&1`;
       }
       if (/ps/i) {
      $errado = 0;
      print $cliente `ps xa 2>&1`;
       }
       if (/disdrobo/i) {
      
      close $cliente;
      exit;
       }       
       if (/arp/i) { 
      $errado = 0;
      print $cliente `arp -a 2>&1`;
       } 
       
       if (/route/i) {    
      $errado = 0;
      print $cliente `route 2>&1`;
       }
       if (/id/i) {
      $errado = 0;
      print $cliente `id 2>&1`;
       }
       if(/\?/i) {
      $errado = 0;
      &ajuda;   
       }
       if(/cls/i) {
      $errado = 0;
      &limpa;
      print $cliente ":: Digite ? para listagem de comandos :: $EOL$EOL";
       }
       if($errado != 0) {
      $n = &msgerro;
      print $cliente @msg_erro[$n]."$EOL";
       }
       &shell;
   }
    
  }

Scripts recomendados

SMTP Mass Mail - Enviando e-mails em massa para vários endereços a partir de um servidor SMTP

fb-brute

VimeoTheSapo -Baixe videos do Vimeo e do sapo

Gmail::SendMail - Enviando emails usando gmail

Web crawler simples em Perl


  

Comentários

Nenhum comentário foi encontrado.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts