Servidor web pequeno e simples em TCL
Publicado por José Lucas (última atualização em 14/05/2021)
[ Hits: 4.490 ]
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
Melhorando o tempo de boot do Fedora e outras distribuições
Como instalar as extensões Dash To Dock e Hide Top Bar no Gnome 45/46
E a guerra contra bots continua
Tradução do artigo do filósofo Gottfried Wilhelm Leibniz sobre o sistema binário
Conheça o firewall OpenGFW, uma implementação do (Great Firewall of China).
Instalando o FreeOffice no LMDE 6
Anki: Remover Tags de Estilo HTML de Todas as Cartas
Colocando uma opção de redimensionamento de imagem no menu de contexto do KDE
Não consigo acessar os modos de desempenho (2)
Ubuntu — tentando iniciar o windows? (0)
[Shell Script] Script para desinstalar pacotes desnecessários no OpenSuse
[Shell Script] Script para criar certificados de forma automatizada no OpenVpn
[Shell Script] Conversor de vídeo com opção de legenda
[C/C++] BRT - Bulk Renaming Tool
[Shell Script] Criação de Usuarios , Grupo e instalação do servidor de arquivos samba