Servidor web pequeno e simples em TCL
Publicado por José Lucas (última atualização em 14/05/2021)
[ Hits: 5.038 ]
Homepage: https://github.com/NIDObr
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
#!/usr/bin/env tclsh
#---------------------------------------------------------
# Author: NidoBr
# E-mail: < coqecoisa@gmail.com >
# 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
Mostrar conexões de rede ativas
Monitorando o Preço do Bitcoin ou sua Cripto Favorita em Tempo Real com um Widget Flutuante
IA Turbina o Desktop Linux enquanto distros renovam forças
Como extrair chaves TOTP 2FA a partir de QRCODE (Google Authenticator)
Ativando e usando "zoom" no ambiente Cinnamon
Vídeo Nostálgico de Instalação do Conectiva Linux 9
Como realizar um ataque de força bruta para desobrir senhas?
Queda no serviços da Cloudflare, alguns sites estão fora do ar. (1)
Perfil criado no samba ad dc não loga no Windows 10 e 11 (11)









