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;
   }
    
  }

Burlando o "Protetor de links" INVERTIDO para download grátis

Localizador de palavras em arquivos nao binarios

Obtendo a temperatura com Perl

Buscar Traduções no Google Translate

Script para X-chat

Nenhum comentário foi encontrado.