Files
jRDC-Multi/Manager.bas
Jose Alberto Guerra Ugalde 616013f0fb - VERSION 5.09.18
- feat(manager): Implementa recarga granular (Hot-Swap).
- Actualiza manager.html para solicitar la DB Key a recargar (ej: DB2).
- Se modifica Manager.bas para leer este parámetro y ejecutar el Hot-Swap de forma atómica solo en el pool de conexión especificado, lo cual mejora la eficiencia y la disponibilidad del servicio.
2025-09-27 14:14:38 -06:00

367 lines
14 KiB
QBasic

B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
' Módulo de clase: Manager
' Este handler proporciona un panel de administración web para el servidor jRDC2-Multi.
' Permite monitorear el estado del servidor, recargar configuraciones de bases de datos,
' ver estadísticas de rendimiento, reiniciar servicios externos, y gestionar la autenticación de usuarios.
Sub Class_Globals
' Objeto para generar respuestas JSON. Se utiliza para mostrar mapas de datos de forma legible.
Dim j As JSONGenerator
' La clase BCrypt no se usa directamente en este módulo, pero se mantiene si hubiera planes futuros.
' Private bc As BCrypt
End Sub
' Subrutina de inicialización de la clase. Se llama cuando se crea un objeto de esta clase.
Public Sub Initialize
' No se requiere inicialización específica para esta clase en este momento.
End Sub
' Método principal que maneja las peticiones HTTP para el panel de administración.
' req: El objeto ServletRequest que contiene la información de la petición entrante.
' resp: El objeto ServletResponse para construir y enviar la respuesta al cliente.
' Módulo de clase: Manager
' ... (tu código de Class_Globals e Initialize se queda igual) ...
' Método principal que maneja las peticiones HTTP para el panel de administración.
' Refactorizado para funcionar como una API con un frontend estático.
Sub Handle(req As ServletRequest, resp As ServletResponse)
' --- 1. Bloque de Seguridad ---
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then
resp.SendRedirect("/login")
Return
End If
Dim Command As String = req.GetParameter("command")
' --- 2. Servidor de la Página Principal ---
If Command = "" Then
Try
resp.ContentType = "text/html; charset=utf-8"
resp.Write(File.ReadString(File.DirApp, "www/manager.html"))
Catch
resp.SendError(500, "Error: No se pudo encontrar el archivo principal del panel (www/manager.html). " & LastException.Message)
End Try
Return
End If
' --- 3. Manejo de Comandos como API ---
Select Command.ToLowerCase
' --- Comandos que devuelven JSON (Métricas del Pool) ---
Case "getstatsold"
resp.ContentType = "application/json; charset=utf-8"
Dim allPoolStats As Map
allPoolStats.Initialize
For Each dbKey As String In Main.listaDeCP
Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
If connector.IsInitialized Then
allPoolStats.Put(dbKey, connector.GetPoolStats)
Else
allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado"))
End If
Next
j.Initialize(allPoolStats)
resp.Write(j.ToString)
Return
Case "getstats"
resp.ContentType = "application/json; charset=utf-8"
Dim allPoolStats As Map
' Leemos del caché global actualizado por el Timer SSE
allPoolStats = Main.LatestPoolStats
For Each dbKey As String In Main.listaDeCP
If allPoolStats.ContainsKey(dbKey) = False Then
allPoolStats.Put(dbKey, CreateMap("Error": "Métricas no disponibles/Pool no inicializado"))
End If
Next
j.Initialize(allPoolStats)
resp.Write(j.ToString)
Return
Case "slowqueries"
resp.ContentType = "application/json; charset=utf-8"
Dim results As List
results.Initialize
Try
' Verifica la existencia de la tabla de logs antes de consultar
Dim tableExists As Boolean = Main.SQL1.ExecQuerySingleResult($"SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs';"$) <> Null
If tableExists = False Then
j.Initialize(CreateMap("message": "La tabla de logs ('query_logs') no existe. Habilita 'enableSQLiteLogs=1' en la configuración."))
resp.Write(j.ToString)
Return
End If
' Consulta las 20 queries más lentas de la última hora
Dim oneHourAgoMs As Long = DateTime.Now - 3600000
Dim rs As ResultSet = Main.SQL1.ExecQuery($"SELECT query_name, duration_ms, datetime(timestamp / 1000, 'unixepoch', 'localtime') as timestamp_local, db_key, client_ip, busy_connections, handler_active_requests FROM query_logs WHERE timestamp >= ${oneHourAgoMs} ORDER BY duration_ms DESC LIMIT 20"$)
Do While rs.NextRow
Dim row As Map
row.Initialize
row.Put("Query", rs.GetString("query_name"))
row.Put("Duracion_ms", rs.GetLong("duration_ms"))
row.Put("Fecha_Hora", rs.GetString("timestamp_local"))
row.Put("DB_Key", rs.GetString("db_key"))
row.Put("Cliente_IP", rs.GetString("client_ip"))
row.Put("Conexiones_Ocupadas", rs.GetInt("busy_connections"))
row.Put("Peticiones_Activas", rs.GetInt("handler_active_requests"))
results.Add(row)
Loop
rs.Close
Dim root As Map
root.Initialize
root.Put("data", results)
j.Initialize(root)
resp.Write(j.ToString)
Catch
Log("Error CRÍTICO al obtener queries lentas en Manager API: " & LastException.Message)
resp.Status = 500
Dim root As Map
root.Initialize
root.Put("data", results)
j.Initialize(root)
resp.Write(j.ToString)
End Try
Return
Case "logs", "totalrequests", "totalblocked"
resp.ContentType = "application/json; charset=utf-8"
Dim mp As Map
If Command = "logs" And GlobalParameters.mpLogs.IsInitialized Then mp = GlobalParameters.mpLogs
If Command = "totalrequests" And GlobalParameters.mpTotalRequests.IsInitialized Then mp = GlobalParameters.mpTotalRequests
If Command = "totalblocked" And GlobalParameters.mpBlockConnection.IsInitialized Then mp = GlobalParameters.mpBlockConnection
If mp.IsInitialized Then
j.Initialize(mp)
resp.Write(j.ToString)
Else
resp.Write("{}")
End If
Return
' --- Comandos que devuelven TEXTO PLANO ---
Case "ping"
resp.ContentType = "text/plain"
resp.Write($"Pong ($DateTime{DateTime.Now})"$)
Return
Case "reload"
resp.ContentType = "text/plain; charset=utf-8"
Dim sbTemp As StringBuilder
sbTemp.Initialize
' ***** LÓGICA DE RECARGA GRANULAR/SELECTIVA *****
Dim dbKeyToReload As String = req.GetParameter("db").ToUpperCase ' Leer parámetro 'db' opcional (ej: /manager?command=reload&db=DB3)
Dim targets As List ' Lista de DBKeys a recargar.
targets.Initialize
' 1. Determinar el alcance de la recarga (selectiva o total)
If dbKeyToReload.Length > 0 Then
' Recarga selectiva
If Main.listaDeCP.IndexOf(dbKeyToReload) = -1 Then
resp.Write($"ERROR: DBKey '${dbKeyToReload}' no es válida o no está configurada."$)
Return
End If
targets.Add(dbKeyToReload)
sbTemp.Append($"Iniciando recarga selectiva de ${dbKeyToReload} (Hot-Swap)..."$).Append(" " & CRLF)
Else
' Recarga completa (comportamiento por defecto)
targets.AddAll(Main.listaDeCP)
sbTemp.Append($"Iniciando recarga COMPLETA de configuración (Hot-Swap) ($DateTime{DateTime.Now})"$).Append(" " & CRLF)
End If
' 2. Deshabilitar el Timer de logs (si es necesario)
Dim oldTimerState As Boolean = Main.timerLogs.Enabled
If oldTimerState Then
Main.timerLogs.Enabled = False
sbTemp.Append(" -> Timer de limpieza de logs (SQLite) detenido temporalmente.").Append(" " & CRLF)
End If
Dim reloadSuccessful As Boolean = True
Dim oldConnectorsToClose As Map ' Guardaremos los conectores antiguos aquí.
oldConnectorsToClose.Initialize
' 3. Procesar solo los conectores objetivos
For Each dbKey As String In targets
sbTemp.Append($" -> Procesando recarga de ${dbKey}..."$).Append(CRLF)
Dim newRDC As RDCConnector
Try
' Crear el nuevo conector con la configuración fresca
newRDC.Initialize(dbKey)
' Adquirimos el lock para el reemplazo atómico
Main.MainConnectorsLock.RunMethod("lock", Null)
' Guardamos el conector antiguo (si existe)
Dim oldRDC As RDCConnector = Main.Connectors.Get(dbKey)
' Reemplazo atómico en el mapa global compartido
Main.Connectors.Put(dbKey, newRDC)
' Liberamos el bloqueo inmediatamente
Main.MainConnectorsLock.RunMethod("unlock", Null)
' Si había un conector antiguo, lo guardamos para cerrarlo después
If oldRDC.IsInitialized Then
oldConnectorsToClose.Put(dbKey, oldRDC)
End If
' 4. Actualizar el estado de logs (Granular)
Dim enableLogsSetting As Int = newRDC.config.GetDefault("enableSQLiteLogs", 0)
Dim isEnabled As Boolean = (enableLogsSetting = 1)
Main.SQLiteLoggingStatusByDB.Put(dbKey, isEnabled)
sbTemp.Append($" -> ${dbKey} recargado. Logs (config): ${isEnabled}"$).Append(CRLF)
Catch
' Si falla la inicialización del pool, no actualizamos Main.Connectors
' ¡CRÍTICO! Aseguramos que el lock se libere si hubo excepción antes de liberar.
If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then
Main.MainConnectorsLock.RunMethod("unlock", Null)
End If
sbTemp.Append($" -> ERROR CRÍTICO al inicializar conector para ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF)
reloadSuccessful = False
Exit
End Try
Next
' 5. Cerrar los pools antiguos liberados (FUERA del Lock)
If reloadSuccessful Then
For Each dbKey As String In oldConnectorsToClose.Keys
Dim oldRDC As RDCConnector = oldConnectorsToClose.Get(dbKey)
oldRDC.Close ' Cierre limpio del pool C3P0
sbTemp.Append($" -> Pool antiguo de ${dbKey} cerrado limpiamente."$).Append(" " & CRLF)
Next
' 6. Re-evaluar el estado global de Logs (CRÍTICO: debe revisar TODAS las DBs)
Main.IsAnySQLiteLoggingEnabled = False
For Each dbKey As String In Main.listaDeCP
' Revisamos el estado de log de CADA conector activo
If Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False) Then
Main.IsAnySQLiteLoggingEnabled = True
Exit
End If
Next
If Main.IsAnySQLiteLoggingEnabled Then
Main.timerLogs.Enabled = True
sbTemp.Append($" -> Timer de limpieza de logs ACTIVADO (estado global: HABILITADO)."$).Append(" " & CRLF)
Else
Main.timerLogs.Enabled = False
sbTemp.Append($" -> Timer de limpieza de logs DESHABILITADO (estado global: DESHABILITADO)."$).Append(" " & CRLF)
End If
sbTemp.Append($"¡Recarga de configuración completada con éxito!"$).Append(" " & CRLF)
Else
' Si falló, restauramos el estado del timer anterior.
If oldTimerState Then
Main.timerLogs.Enabled = True
sbTemp.Append(" -> Restaurando Timer de limpieza de logs al estado ACTIVO debido a fallo en recarga.").Append(" " & CRLF)
End If
sbTemp.Append($"¡ERROR: La recarga de configuración falló! Los conectores antiguos siguen activos."$).Append(" " & CRLF)
End If
resp.Write(sbTemp.ToString)
Return
Case "test"
resp.ContentType = "text/plain; charset=utf-8"
Dim sb As StringBuilder
sb.Initialize
Try
Dim con As SQL = Main.Connectors.Get("DB1").As(RDCConnector).GetConnection("")
sb.Append("Connection successful." & CRLF & CRLF)
Dim estaDB As String = ""
Log(Main.listaDeCP)
For i = 0 To Main.listaDeCP.Size - 1
If Main.listaDeCP.get(i) <> "" Then estaDB = "." & Main.listaDeCP.get(i)
sb.Append($"Using config${estaDB}.properties"$ & CRLF)
Next
con.Close
resp.Write(sb.ToString)
Catch
resp.Write("Error fetching connection: " & LastException.Message)
End Try
Return
Case "rsx", "rpm2", "revivebow", "restartserver"
resp.ContentType = "text/plain; charset=utf-8"
Dim batFile As String
Select Command
Case "rsx": batFile = "start.bat"
Case "rpm2": batFile = "reiniciaProcesoPM2.bat"
Case "reviveBow": batFile = "reiniciaProcesoBow.bat"
Case "restartserver": batFile = "restarServer.bat" ' Nota: este bat no estaba definido, se usó el nombre del comando
End Select
Log($"Ejecutando ${File.DirApp}\${batFile}"$)
Try
Dim shl As Shell
shl.Initialize("shl","cmd", Array("/c", File.DirApp & "\" & batFile & " " & Main.srvr.Port))
shl.WorkingDirectory = File.DirApp
shl.Run(-1)
resp.Write($"Comando '${Command}' ejecutado. Script invocado: ${batFile}"$)
Catch
resp.Write($"Error al ejecutar el script para '${Command}': ${LastException.Message}"$)
End Try
Return
Case "paused", "continue"
resp.ContentType = "text/plain; charset=utf-8"
If Command = "paused" Then
GlobalParameters.IsPaused = 1
resp.Write("Servidor pausado.")
Else
GlobalParameters.IsPaused = 0
resp.Write("Servidor reanudado.")
End If
Return
Case "block", "unblock"
resp.ContentType = "text/plain; charset=utf-8"
Dim ip As String = req.GetParameter("IP")
If ip = "" Then
resp.Write("Error: El parámetro IP es requerido.")
Return
End If
If GlobalParameters.mpBlockConnection.IsInitialized Then
If Command = "block" Then
GlobalParameters.mpBlockConnection.Put(ip, ip)
resp.Write($"IP bloqueada: ${ip}"$)
Else
GlobalParameters.mpBlockConnection.Remove(ip)
resp.Write($"IP desbloqueada: ${ip}"$)
End If
Else
resp.Write("Error: El mapa de bloqueo no está inicializado.")
End If
Return
Case Else
resp.ContentType = "text/plain; charset=utf-8"
resp.SendError(404, $"Comando desconocido: '{Command}'"$)
Return
End Select
End Sub