Servidor web pequeno e simples em TCL

Publicado por José Lucas (última atualização em 14/05/2021)

[ Hits: 1.385 ]

Homepage: https://github.com/NIDObr ; https://minemam-br.blogspot.com/

Download smallws.tcl




Bom dia, estou estudando TCL e fiz esse script como um experimento, funciona porem é muito simples. Pretendo melhorar ele com o tempo, espero que gostem!

https://github.com/NIDObr/smallws

  



Esconder código-fonte

#!/usr/bin/env tclsh

#---------------------------------------------------------
# Author: NidoBr
# E-mail: < [email protected] >
# Github: < https://github.com/NIDObr >
# Versão: Alpha 15/03/2021
# Licença: BSD 3-Clause "New" or "Revised" License
# OPLTOOL:
#   Small web server
#---------------------------------------------------------

#-------------------------------------------------Package

# Log tool
#package require logtool 1.0

#----------------------------------------------------Vars

# Nome do programa
set ::_pname $argv0
# Diretorio raiz (onde estara o site)
set ::_root "/home/nido/Documentos/scripts/html/repo_opl"
#1 Primeira pagina
set ::_index "/index.html"
# Porta do servidor
set _port "6921"

#--------------------------------------------------Funções

# Inicia o servidor
proc InitServer { port } {
   # Cria o canal de rede na porta especificada e chama a função InirCfg
   set ::_wssock [ socket -server InitCfg $port ]
   puts "[ clock format [ clock seconds ] -format {%b %d %H:%M:%S} ] - Servidor iniciado."
   # Mantem o programa rodando em loop
   vwait forever
}
# Indentifica se o canal esta disponivel
proc InitCfg { _sockid _ipremot port } {
   # Se o canal estiver disponivel chama a função cfgWebSW
   fileevent $_sockid readable [ list cfgWebSW $_sockid $_ipremot ]
}
# Configura o canal
proc cfgWebSW { _sockid _ipremot } {
   fconfigure $_sockid -translation binary -buffering full
   fconfigure $_sockid -blocking 0
   if { [ fblocked $_sockid ] } then { return }
   fileevent $_sockid readable [ list WebSW $_sockid ]
}
# Informações sobre o browser
proc Header { _sockid } {
   puts $_sockid "HTTP/1.1 200 OK"
   puts $_sockid ""
   set _header [ read $_sockid ]
   puts "$_header"
}
# Trasfere as paginas ao browser
proc WebSW { _sockid } {
   set _sockline [ gets $_sockid ]
   # Le as requisiçoes do browser
   if { $_sockline != " " } {
      Header $_sockid
   }
   set _sockline [ regsub "GET " $_sockline "" ]
    set _sockline [ regsub " HTTP/1.1" $_sockline "" ]
   # Se não for solicitada uma pagina edpecifica, exibe a pagina padrão 
   if { [ eval string index $_sockline 1 ] == "" } {
      set _pfile [ open "$::_root$::_index" r ]
   } else {
      set _pfile [ eval open $::_root$_sockline r ]
   }
   fconfigure $_pfile -translation binary
   # Transfere os dados ao browser
   fileevent $_sockid readable [ fcopy $_pfile $_sockid -command [ list done $_pfile $_sockid ] ]

}
# Fecha os canais referente ao socket e ao arquivo enviado ao browser
proc done { _pfile _sockid _transferbit } {
   close $_pfile
   close $_sockid
}

#-------------------------------------------------Principal

# Start log
#logtool:log_mes "Iniciando serviço..." $::_pname "INFO"

puts "[ clock format [ clock seconds ] -format {%b %d %H:%M:%S} ] - Iniciando."
# Inicia o servidor na porta especificada
InitServer $_port

Scripts recomendados

Firewall Bloqueando Tudo

Backup via scp

Backup via scp

Mostrar conexões de rede ativas

Tcl de piadas


  

Comentários
[1] Comentário enviado por fabio em 14/05/2021 - 05:45h

TCL foi a primeira linguagem interpretada que aprendi. Bons tempos! Fiz bastante coisa legal em TCL/TK no final dos anos 90.

[2] Comentário enviado por mauricio123 em 14/05/2021 - 10:32h


Muito bacana.

___________________________________________________________
[code]Conhecimento não se Leva para o Túmulo.
https://github.com/MauricioFerrari-NovaTrento [/code]


Contribuir com comentário