Servidor BBS

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

[ Hits: 7.589 ]

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

Scripts recomendados

Script para X-chat

Buscar Traduções no Google Translate

Web crawler simples em Perl

Sarg Semanal

AUTENTICACAO VELOX


  

Comentários

Nenhum comentário foi encontrado.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts