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.

• Download servidor.pl
• Enviar nova versão

Esconder código-fonte

#!/usr/bin/perl

############ INFO ###########
### Autor: Carcarah
### Email: thenazgul@terra.com.br
### 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;
   }
    
  }

PDF completo com todas as páginas do Diário Oficial do Estado de Goiás

Upload de múltiplos arquivos para Imageshack.us

Postando mensagem no Facebook com Perl

Buscar Traduções no Google Translate

Descubra se seu e-mail ou conta foi "pwned"

Nenhum comentário foi encontrado.