{--------------------------------------------------------}
{          sitiovox - processamento geral
{--------------------------------------------------------}

unit svProc;
interface
uses dvCrt, dvWin, dvinet, winprocs, wintypes, winsock, strings,
     svvars, svMsg, svFila, svrede, svdog;

function iniciaServidor: boolean;
procedure processa;

implementation

var
    quemTestar: integer;
    quemEnviar: integer;
    msgAEnviar, envAEnviar, destAEnviar: string;
    caracVivo: integer;

{--------------------------------------------------------}
{             faz um desenhinho na tela
{--------------------------------------------------------}

procedure mostraQueEstaVivo;
const
    tabVivo: array [0..3] of char = ('-', '\', '|', '/');
begin
    caracVivo := (caracVivo + 1) mod 4;
    write (tabVivo [caracVivo]);
    gotoxy (1, wherey);
    keypressed;
end;

{--------------------------------------------------------}
{            escreve uma mensagem num soquete
{--------------------------------------------------------}

function writeMsgRede (sock: integer; msg: string): boolean;
begin
     writeMsgRede := enviaRede (sock, DADOTECLADO, @msg[1], length (msg));
end;

{--------------------------------------------------------}
{               inicializa escuta no soquete
{--------------------------------------------------------}

function iniciaServidor: boolean;
begin
    sockEscuta := escutaConexao (portaSitio);
    if sockEscuta < 0 then
         begin
             mensagem ('SVPORDES', 1);    {Porta de escuta desabilitada ou já usada}
             mensagem ('SVPROCAN', 1);    {Programa cancelado}
             iniciaServidor := false;
         end
    else
         begin
             mensagem ('SVSVATIV', 1);   {Servidor ativo aceitando conexões}
             iniciaServidor := true;
         end;
end;

{--------------------------------------------------------}
{    ve se houve alguma ocorrencia no socket de escuta
{--------------------------------------------------------}

procedure checaNovosUsuarios;
var s: string;
    maxVezes: integer;
    sockLixo: integer;

var endip: sockAddr;
    tam: integer;

label cancelou;
begin
    if chegouRede (sockEscuta) then
        begin
            if nUsuarios >= MAXCONEX then
                begin
                    sockLixo := aceitaConexao (sockescuta);
                    writelnRede (sockLixo, MSGEXCEDIDO);
                    delay (1000);
                    fechaConexao (sockLixo);
                end;

            nusuarios := nusuarios + 1;
            new (conexao [nusuarios]);

            with conexao [nusuarios]^ do
                begin
                    sock := aceitaConexao (sockescuta);
                    nome := '';
                    apelido := '';
                    ativo := false;

                    if sock >= 0 then
                        begin
                            tam := sizeof (sockaddr);
                            getpeername(sock, endip, tam);

                            if fazLog then
                                begin
                                    {$I-} writeln (arqlog, 'Aceitei conexão de ' +
                                             strPas (inet_ntoa (endip.sin_addr.S_addr))); {$I+}
                                    if ioresult <> 0 then fazLog := false;
                                end;

                            writelnRede (sock, '+OK - entrada registrada de ' +
                                 strPas (inet_ntoa (endip.sin_addr.S_addr)));
                            meuBuf := inicBufRede (sock);
                            write ('Aceitei conexão de ' +
                                 strPas (inet_ntoa (endip.sin_addr.S_addr)));

                            maxVezes := 20;
                            repeat
                                delay (500);
                                maxVezes := maxVezes - 1;
                            until temDadoBufRede (meuBuf) or (maxVezes = 0);
                            if maxVezes <> 0 then
                                readlnBufRede (meuBuf, nome);

                            fimBufRede (meuBuf);
                            if maxVezes = 0 then
                                begin
                                    writeln (' - usuário cancelado');

                                    if fazLog then
                                        begin
                                            {$I-} writeln (arqlog, '== >usuário cancelado'); {$I+}
                                             if ioresult <> 0 then fazLog := false;
                                        end;

                                    goto cancelou;
                                end;

                            writelnRede (sock, '+OK');

                            str (nusuarios-1, s);
                            if (nome[1] = '+') or (nome[1] = '-')     then goto cancelou;
                            if not writeMsgRede (sock, msgBoasVindas) then goto cancelou;
                            if not writeMsgRede (sock, MSGATIVOS+s)   then goto cancelou;
                            if not writeMsgRede (sock, MSGDIGAPELIDO) then goto cancelou;

                            writeln (' - ', nome);
                        end
                   else
                       begin
cancelou:
                           fechaConexao (sock);
                           nusuarios := nusuarios - 1;
                       end;
                end;
        end;
end;

{--------------------------------------------------------}
{                trata saida de um usuario
{--------------------------------------------------------}

procedure usuarioCaiu (quem: integer);
var i: integer;
begin
    writeln (MSGCAIU + conexao [quem]^.apelido);
    insereFilaMsg ('*', '*', MSGCAIU + conexao [quem]^.apelido);

    with conexao [quem]^ do
        begin
            fechaConexao (sock);
            dispose (conexao [quem]);
        end;

    for i := quem to nusuarios-1 do
        conexao [i] := conexao [i+1];

    nusuarios := nusuarios - 1;
    quemTestar := quemTestar - 1;
end;

{--------------------------------------------------------}
{          divide cadeia lida em destino/mensagem
{--------------------------------------------------------}

procedure extraiDestino (var s, dest: string);
begin
    if (s <> '') and (s[1] = '+') then
        begin
            dest := '';
            delete (s, 1, 1);
            while (s <> '') and (s[1] <> ' ') do
                begin
                    dest := dest + upcase (s[1]);
                    delete (s, 1, 1);
                end;
            delete (s, 1, 1);
        end
    else
        dest := '*';
end;

{--------------------------------------------------------}
{              busca usuario por apelido
{--------------------------------------------------------}

function buscaApelido (dest: string): integer;
var i, j: integer;
    apel: string;
begin
    for j := 1 to length (dest) do
        dest[j] := upcase (dest[j]);

    for i := 1 to nusuarios do
        with conexao[i]^ do
            begin
                apel := apelido;
                for j := 1 to length (apel) do
                    apel[j] := upcase (apel[j]);

                if apel = dest then
                    begin
                        buscaApelido := i;
                        exit;
                    end;
            end;

    buscaApelido := 9999;
end;

{--------------------------------------------------------}
{                  comandos locais
{--------------------------------------------------------}

procedure comandosLocais (quem: integer; msg: string);
var i: integer;
    s: string;

begin
    with conexao [quem]^ do
        begin
            for i := 1 to length (msg) do
                msg [i] := upcase (msg[i]);

            if msg = '?' then
                begin
                    writeMsgRede (sock, DICA1);
                    writeMsgRede (sock, DICA2);
                    writeMsgRede (sock, DICA3);
                    writeMsgRede (sock, DICA4);
                    writeMsgRede (sock, DICA5);
                    writeMsgRede (sock, DICA6);
                end
            else
            if msg = '?QUANTOS' then
                begin
                    str (nusuarios, s);
                    writeMsgRede (sock, MSGATIVOS+s);
                end
            else
            if msg = '?QUEM' then
                begin
                    for i := 1 to nusuarios do
                        begin
                             if conexao[i] <> NIL then
                                 if conexao[i]^.apelido = '' then
                                     writeMsgRede (sock, '<Usuário entrando>')
                                 else
                                     writeMsgRede (sock, conexao[i]^.apelido);
                        end;
                end
            else
                writeMsgRede (sock, MSGINVALIDA);
        end;
end;

{--------------------------------------------------------}
{                  compacta um apelido
{--------------------------------------------------------}

function compactaBrancos (s: string): string;
var p: integer;
begin
    repeat
        p := pos (' ', s);
        if p <> 0 then
            delete (s, p, 1)
        else
            compactaBrancos := s;
    until p = 0;

    for p := 1 to length (s) do
        if (s[p] < #$20) then
            s[p] := '#';
end;

{--------------------------------------------------------}
{            enfileira uma mensagem chegada
{--------------------------------------------------------}

procedure checaMensagemChegada (quem: integer);
var s: string;
    dest: string;
    n: integer;

begin
    with conexao [quem]^ do
        begin
            if not chegouRede (sock) then
                exit;

            if not leLinhaRede (sock, s) then
                usuarioCaiu (quem)
            else
                begin
                    if (s <> '')  and (s[1] = '?') then
                        begin
                            comandosLocais (quem, s);
                            exit;
                        end;

                    extraiDestino (s, dest);

                    if apelido = '' then    { teste da primeira vez: ele ainda nao tem apelido }
                        begin
                            apelido := compactaBrancos (s);
                            ativo := true;
                            if apelido = '' then
                                usuarioCaiu (quem)
                            else
                                begin
                                    if comCachorro then
                                        lateCachorro;
                                    writeln ('Apelido: ', apelido);
                                    comandosLocais (quem, '?QUANTOS');
                                    comandosLocais (quem, '?QUEM');
                                    insereFilaMsg ('', apelido, MSGAJUDA);
                                    insereFilaMsg (apelido, '*', MSGENTRA);
                                end;
                            exit;
                        end;

                    if dest = '*' then
                        begin
                           insereFilaMsg (apelido, dest, s);
                           if comCachorro and
                              ((nusuarios <= 1) or (random (100) = 1)) then
                               lateCachorro;
                        end
                    else
                        begin
                            n := buscaApelido (dest);     { ve se destino existe }
                            if n = 9999 then
                                insereFilaMsg ('*', apelido, dest+MSGUSUINEX)
                            else
                                insereFilaMsg (apelido, dest, '(pvt) ' + s);
                        end;
                end;
        end;
end;

{--------------------------------------------------------}
{         despacha mensagem para próximo usuário
{--------------------------------------------------------}

procedure despachaUmaMensagem;
begin
    quemEnviar := quemEnviar + 1;
    if quemEnviar > nusuarios then
         begin
             if temMsgFila then
                 begin
                      removeFilaMsg (envAEnviar, destAEnviar, msgAEnviar);

                      if destAEnviar <> '*' then
                           quemEnviar := buscaApelido (destAEnviar)
                      else
                           quemEnviar := 1;

                      { talvez deva verificar caso extremo de destino acabar de cair }
                 end
             else
                 begin
                     quemEnviar := 9999;
                     exit;
                 end;
         end;

    if (quemEnviar > 0) and (quemEnviar < 9999) then
        if (conexao [quemEnviar] <> NIL) and
           (conexao [quemEnviar]^.ativo) and
           (msgAEnviar <> '') then
            if not writeMsgRede (conexao [quemEnviar]^.sock, envAEnviar + '.' + msgAEnviar) then
                usuarioCaiu (quemEnviar);

    if destAEnviar <> '*' then       {envio para um só}
         quemEnviar := 9999;
end;

{--------------------------------------------------------}
{                 mostra usuarios ativos
{--------------------------------------------------------}

procedure mostraAtivos;
const
    brancos = '                  ';
var
    i: integer;
    s: string;
    endip: sockAddr;
    tam: integer;
begin
    if nusuarios = 0 then
        sintWriteln ('Ninguém ativo')
    else
        begin
            sintWriteln ('Lista de usuários ativos');
            for i := 1 to nusuarios do
                with conexao[i]^ do
                    begin
                        if apelido = '' then
                             s := '<Alguém entrando> '
                        else
                             s := copy (apelido+brancos, 1, 18);
                        sintWrite (s);
                        tam := sizeof (sockaddr);
                        getpeername(sock, endip, tam);
                        write (strPas (inet_ntoa (endip.sin_addr.S_addr))+ '  ');
                        writeln (nome);
                    end;
        end;
end;

{--------------------------------------------------------}
{               ciclo de processamento geral
{--------------------------------------------------------}

procedure processa;
var
    c, c2: char;
    processando: boolean;
    env, dest, msg: string;

begin
    mensagem ('SVAPTESC', 1);    {'Aperte ESC para terminar'}

    quemTestar := 9999;
    quemEnviar := 9999;
    processando := true;
    while processando do
        begin
             mostraQueEstaVivo;

             if keypressed then
                 begin
                     c := readkey;
                     if c = ' ' then
                         mostraAtivos
                     else
                     if c = ESC then
                         begin
                             mensagem ('SVCNFFIM', 0);
                             sintLeTecla (c, c2);
                             writeln;

                             if upcase (c) = 'S' then
                                 processando := false
                         end
                     else
                         begin
                             sintClek;
                         end;
                 end
             else
                 begin
                     checaNovosUsuarios;

                     if nusuarios > 0 then
                         begin
                             quemTestar := quemTestar + 1;
                             if quemTestar > nusuarios then
                                 quemTestar := 1;
                             checaMensagemChegada (quemTestar);
                         end;

                     despachaUmaMensagem;
                 end;
        end;
end;

end.
