Servidor web pequeno e simples em TCL
Publicado por José Lucas (última atualização em 14/05/2021)
[ Hits: 5.079 ]
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
Modo Simples de Baixar e Usar o bash-completion
Monitorando o Preço do Bitcoin ou sua Cripto Favorita em Tempo Real com um Widget Flutuante
[Resolvido] dlopen(): error loading libfuse.so.2 AppImages require FUSE to run.
Criação de diretórios e aplicação de restrições de acesso no Linux
Instalando partes faltantes do Plasma 6
ClamAV, um montão de coisas suspeitas .... (0)
Script instalaçao gateway RAK831 (2)









