cheveguerra/jRDC-MultiDB-Hikari
1
0
Fork 0
mirror of https://github.com/KeymonSoft/jRDC-MultiDB-Hikari.git synced 2026-04-20 06:09:30 +00:00
Code Issues Packages Projects Releases Wiki Activity

- VERSION 5.10.27

Browse Source 
- feat(arquitectura): Consolidación de estabilidad y diagnóstico.
- refactor: Arquitectura de base de datos local y políticas de logs.
- arch(sqlite): Aislamiento total de las conexiones SQLite en SQL_Auth y SQL_Logs. Esto protege las operaciones de autenticación críticas de la alta carga de I/O generada por el subsistema de logs.
- feat(logs): Implementación de modo de almacenamiento flexible para logs (disco o en memoria), mejorando la capacidad de testing.
- refactor(logs): Se estandariza el límite de retención de registros a 10,000 para todas las tablas de logs, y se renombra la subrutina de limpieza a borraArribaDe10000Logs.
This commit is contained in:
jaguerrau
2025-10-29 05:25:49 -06:00
parent 4c7639f867
commit 9c9e2975e9
12 changed files with 1390 additions and 1374 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
Cambios.bas
View File

@@ -22,6 +22,16 @@ Sub Process_Globals
' - Que en el reporte de "Queries lentos" se pueda especificar de cuanto tiempo, ahorita esta solo de la ultima hora, pero que se pueda seleccionar desde una ' - Que en el reporte de "Queries lentos" se pueda especificar de cuanto tiempo, ahorita esta solo de la ultima hora, pero que se pueda seleccionar desde una
' lista, por ejemplo 15, 30, 45 y 60 minutos antes. ' lista, por ejemplo 15, 30, 45 y 60 minutos antes.
- VERSION 5.10.27
feat(arquitectura): Consolidación de estabilidad y diagnóstico.
refactor: Arquitectura de base de datos local y políticas de logs.
- arch(sqlite): Aislamiento total de las conexiones SQLite en SQL_Auth y SQL_Logs. Esto protege las operaciones de autenticación críticas de la alta carga de I/O generada por el subsistema de logs.
- feat(logs): Implementación de modo de almacenamiento flexible para logs (disco o en memoria), mejorando la capacidad de testing.
- fix(manager): Se corrige la inestabilidad del reporte /slowqueries (NumberFormatException) al omitir parámetros y se habilita el ordenamiento dinámico de las columnas.
- refactor(logs): Se estandariza el límite de retención de registros a 10,000 para todas las tablas de logs, y se renombra la subrutina de limpieza a borraArribaDe10000Logs.
' - VERSION: 5.10.25 ' - VERSION: 5.10.25
' - refactor(hikari): Migración completa de C3P0 a HikariCP. Corrección de Hot-Swap y estabilización de la concurrencia. ' - refactor(hikari): Migración completa de C3P0 a HikariCP. Corrección de Hot-Swap y estabilización de la concurrencia.
' - El cambio principal es la sustitución del pool de conexiones C3P0 por HikariCP (versión 4.0.3). Esto resuelve problemas de estabilidad y reduce el overhead de sincronización, moviendo la infraestructura de pooling a un estándar industrial más robusto y rápido. ' - El cambio principal es la sustitución del pool de conexiones C3P0 por HikariCP (versión 4.0.3). Esto resuelve problemas de estabilidad y reduce el overhead de sincronización, moviendo la infraestructura de pooling a un estándar industrial más robusto y rápido.

25
ChangePassHandler.bas
View File

@@ -14,7 +14,7 @@ Public Sub Initialize
End Sub End Sub
Public Sub Handle(req As ServletRequest, resp As ServletResponse) Public Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("--- CHANGEPASSHANDLER FUE LLAMADO ---") ' <--- ¡PON ESTA LÍNEA AQUÍ! Log("--- CHANGEPASSHANDLER FUE LLAMADO ---")
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then
resp.SendRedirect("/login") resp.SendRedirect("/login")
Return Return
@@ -26,27 +26,26 @@ Public Sub Handle(req As ServletRequest, resp As ServletResponse)
Dim confirmPass As String = req.GetParameter("confirm_password") Dim confirmPass As String = req.GetParameter("confirm_password")
If newPass <> confirmPass Then If newPass <> confirmPass Then
resp.Write("<script>alert('Error: La nueva contraseña no coincide con la confirmación.'); history.back();</script>") resp.Write("Las contraseñas no coinciden.")
Return Return
End If End If
Try Try
Dim storedHash As String = Main.SQL1.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(currentUser)) ' 1. Verification of the current password hash using SQL_Auth.
Dim storedHash As String = Main.SQL_Auth.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(currentUser))
Log("Valor de la BD (storedHash): " & storedHash) Log("Valor de la BD (storedHash): " & storedHash)
If storedHash = Null Or bc.checkpw(currentPass, storedHash) = False Then ' <<--- CAMBIO CLAVE AQUÍ
resp.Write("<script>alert('Error: La contraseña actual es incorrecta.'); history.back();</script>") If storedHash = Null Or bc.checkpw(currentPass, storedHash) = False Then
resp.Write("Contraseña actual incorrecta.")
Return Return
End If End If
' <<--- CORRECCIÓN 2: Usamos el método seguro y consistente con 'Main'. ' 2. Hashing and updating the new password using SQL_Auth.
Dim newHashedPass As String = bc.hashpw(newPass, bc.gensalt) Dim newHashedPass As String = bc.hashpw(newPass, bc.gensalt)
Main.SQL1.ExecNonQuery2("UPDATE users SET password_hash = ? WHERE username = ?", Array As Object(newHashedPass, currentUser)) Main.SQL_Auth.ExecNonQuery2("UPDATE users SET password_hash = ? WHERE username = ?", Array As Object(newHashedPass, currentUser))
resp.Write("<script>alert('Contraseña actualizada correctamente.'); window.location.href='/manager';</script>") resp.Write("Contraseña cambiada exitosamente.")
Catch Catch
Log(LastException) Log(LastException)
resp.Write("<script>alert('Error del servidor al intentar cambiar la contraseña.'); history.back();</script>") resp.Write("Error interno al cambiar la contraseña.")
End Try End Try
End Sub End Sub

184
ConnectionPoolManager.bas
View File

@@ -1,184 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=6.01
@EndOfDesignText@
'Class module
'Author: Oliver Ackermann
'Created on: 2018/05/08
Sub Class_Globals
Private pools As Map
Private pool As Object 'Connection pool object
Private poolJO As JavaObject
Private standardConnection As Boolean
Private activePool As Boolean
Private defaultPoolType As String
End Sub
'Initialze ConnectionPoolWrapper
Public Sub Initialize
Reset
End Sub
Private Sub Reset
' Dim H2Pool As H2ConnectionPool
' H2Pool.Initialize
' Dim HSQLPool As HSQLDBConnectionPool
' HSQLPool.Initialize
Dim HikariPool As HikariConnectionPool
HikariPool.Initialize
' Dim C3P0Pool As C3P0ConnectionPool
' C3P0Pool.Initialize
' Dim TomcatPool As TomcatConnectionPool
' TomcatPool.Initialize
' Dim ViburPool As ViburConnectionPool
' ViburPool.Initialize
pools.Initialize
' pools.Put("H2", H2Pool)
' pools.Put("HSQLDB", HSQLPool)
pools.Put("Hikari", HikariPool)
' pools.Put("C3P0", C3P0Pool)
' pools.Put("Tomcat", TomcatPool)
' pools.Put("Vibur", ViburPool)
defaultPoolType = "Hikari" ' <-- Esto ya estaba bien, pero lo dejamos incondicionalmente [5]
standardConnection = False
activePool = False
End Sub
'Create a given pool type
' poolType - type of connection pool to create.
' driverClass - JDBC driver class.
' jdbcUrl - JDBC connection url.
' aUser / aPassword - Connection credentials.
' poolSize - Maximum size of connection pool.
Public Sub CreatePool(poolType As String, driverClass As String, jdbcUrl As String, aUser As String, aPassword As String, poolSize As Int)
'Check poolType
If pools.ContainsKey(poolType) = False Then
Log($"Warning: Connection pool type ${poolType} not supported"$)
If poolType = defaultPoolType Then
Log($" Error: Default pool type ${poolType} not supported."$)
Return
Else
Log($" Switching to default pool type ${defaultPoolType}"$)
If pools.ContainsKey(defaultPoolType) Then
poolType = defaultPoolType
Else
Log($" Error: Default pool type ${defaultPoolType} not supported."$)
Return
End If
End If
End If
Dim thePool As Object = pools.Get(poolType)
'Check jdbcUrl
If jdbcUrl.StartsWith("jdbc:") = False Then
Log($"Error: Invalid JDBC URL: ${jdbcUrl}"$)
Return
End If
If SubExists(thePool, "SupportUrl") And CallSub2(thePool, "SupportUrl", jdbcUrl) = False Then
Log($"Error: Unsupported JDBC URL: ${jdbcUrl}"$)
Return
End If
'Initialize pool
Dim options As Map
options.Initialize
options.Put("driver", driverClass)
options.Put("url", jdbcUrl)
options.Put("user", aUser)
options.Put("password", aPassword)
options.Put("poolsize", poolSize)
CallSub2(thePool, "CreatePool3", options)
'See if we can use own GetConnection without use of CallSub
If SubExists(thePool, "IsStandardConnection") And CallSub(thePool, "IsStandardConnection") Then
standardConnection = True
Log($"Info: ${poolType} supports getConnection JavaObject method."$)
poolJO = CallSub(thePool, "GetPoolJO")
Else
Log($"Info: ${poolType} does not support getConnection JavaObject Method."$)
Log($"Info: Checking if ${poolType} has alternative GetConnection method."$)
If SubExists(thePool, "GetConnection") = False Then
Log($"Error: ${poolType} has no GetConnection method."$)
Return
End If
End If
'Everthing looks good sofar
pool = thePool
activePool = True
End Sub
Public Sub SetProperties(properties As Map)
CallSub2(pool, "SetProperties", properties)
End Sub
'Retrieves a connection from the pool. Make sure to close the connection when you are done with it.
Public Sub GetConnection As SQL
Dim newSQL As SQL
If standardConnection Then
Dim jo As JavaObject = newSQL
jo.SetField("connection", poolJO.RunMethod("getConnection", Null))
Else
newSQL = CallSub(pool, "GetConnection")
End If
Return newSQL
End Sub
' Devuelve el wrapper del pool (ej. HikariConnectionPool) basado en el tipo.
Public Sub GetPool(poolType As String) As Object
If pools.ContainsKey(poolType) Then
Return pools.Get(poolType)
Else
' Si el poolType no está en el mapa, devolvemos Null.
Return Null
End If
End Sub
'Closes all unused pooled connections.
Public Sub ClosePool
Log("ConnectionManager ClosePool")
If activePool Then
Log("About to call Connection Pool's ClosePool")
CallSub(pool, "ClosePool")
Log("Returned from Connection Pool's ClosePool")
End If
Log("Re-initializing Connection Pool Manager")
Reset
Log("Done")
End Sub
' Cierra un pool específico identificado por su tipo (ej. "Hikari", "C3P0").
' Esto permite el cierre granular necesario para el Hot-Swap.
Public Sub ClosePoolByType(poolType As String)
Log($"ConnectionManager: Intentando cerrar pool de tipo ${poolType}"$)
If pools.ContainsKey(poolType) Then
Dim thePool As Object = pools.Get(poolType)
If thePool <> Null And SubExists(thePool, "ClosePool") Then
Log($"ConnectionManager: Delegando ClosePool a ${poolType} wrapper."$)
CallSub(thePool, "ClosePool")
' NOTA: Generalmente, mantenemos el wrapper en el mapa 'pools' (no lo removemos)
' porque la inicialización del Manager crea estos objetos una sola vez al inicio.
Else
Log($"ERROR: Wrapper de pool ${poolType} no disponible o no tiene método ClosePool."$)
End If
Else
Log($"ADVERTENCIA: Tipo de pool ${poolType} no registrado en el Manager."$)
End If
End Sub

267
DBHandlerJSON.bas
View File

@@ -4,139 +4,134 @@ ModulesStructureVersion=1
Type=Class Type=Class
Version=10.3 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
' Módulo de clase: DBHandlerJSON ' Class module: DBHandlerJSON
' Este handler se encarga de procesar las peticiones HTTP que esperan o envían datos en formato JSON. ' This handler is responsible for processing HTTP requests that expect or send data in JSON format.
' Es ideal para clientes web (JavaScript, axios, etc.) o servicios que interactúan con el servidor ' It is ideal for web clients (JavaScript, axios, etc.) or services that interact with the server
' mediante un API RESTful. Soporta tanto GET con JSON en un parámetro 'j' como POST con JSON ' via a RESTful API. It supports both GET with JSON in a 'j' parameter and POST with JSON
' en el cuerpo de la petición. ' in the request body.
Sub Class_Globals Sub Class_Globals
' Declara una variable privada para mantener una instancia del conector RDC. ' Declares a private variable to hold an instance of the RDC connector.
' Este objeto maneja la comunicación con la base de datos específica de la petición. ' This object manages communication with the request's specific database.
Private Connector As RDCConnector Private Connector As RDCConnector
End Sub End Sub
' Subrutina de inicialización de la clase. Se llama cuando se crea un objeto de esta clase. ' Class initialization subroutine. Called when an object of this class is created.
Public Sub Initialize Public Sub Initialize
' No se requiere inicialización específica para esta clase en este momento. ' No specific initialization is required for this class at this time.
End Sub End Sub
' Este es el método principal que maneja las peticiones HTTP entrantes (req) y prepara la respuesta (resp). ' This is the main method that handles incoming HTTP requests (req) and prepares the response (resp).
Sub Handle(req As ServletRequest, resp As ServletResponse) Sub Handle(req As ServletRequest, resp As ServletResponse)
' --- Headers CORS (Cross-Origin Resource Sharing) --- ' CORS (Cross-Origin Resource Sharing) Headers
' Estos encabezados son esenciales para permitir que aplicaciones web (clientes) ' These headers are essential to allow web applications (clients)
' alojadas en diferentes dominios puedan comunicarse con este servidor. ' hosted on different domains to communicate with this server.
resp.SetHeader("Access-Control-Allow-Origin", "*") ' Permite peticiones desde cualquier origen. resp.SetHeader("Access-Control-Allow-Origin", "*") ' Allows requests from any origin.
resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") ' Métodos HTTP permitidos. resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") ' Allowed HTTP methods.
resp.SetHeader("Access-Control-Allow-Headers", "Content-Type") ' Encabezados permitidos. resp.SetHeader("Access-Control-Allow-Headers", "Content-Type") ' Allowed headers.
' Las peticiones OPTIONS son pre-vuelos de CORS y no deben procesar lógica de negocio ni contadores. ' OPTIONS requests are CORS pre-flights and should not process business logic or counters.
If req.Method = "OPTIONS" Then If req.Method = "OPTIONS" Then
Return ' Salimos directamente para estas peticiones. Return ' We exit directly for these requests.
End If End If
Dim start As Long = DateTime.Now ' Registra el tiempo de inicio de la petición para calcular la duración. Dim start As Long = DateTime.Now ' Record the request start time to calculate duration.
' Declaraciones de variables con alcance en toda la subrutina para asegurar la limpieza final. ' Variable declarations with scope throughout the sub to ensure final cleanup.
Dim con As SQL ' La conexión a la BD, se inicializará más tarde. Dim con As SQL ' The DB connection, will be initialized later.
Dim queryNameForLog As String = "unknown_json_command" ' Nombre del comando para el log, con valor por defecto. Dim queryNameForLog As String = "unknown_json_command" ' Command name for the log, with a default value.
Dim duration As Long ' La duración total de la petición, calculada antes del log. Dim duration As Long ' The total request duration, calculated before logging.
Dim poolBusyConnectionsForLog As Int = 0 ' Contiene el número de conexiones ocupadas del pool. Dim poolBusyConnectionsForLog As Int = 0 ' Contains the number of busy connections from the pool.
Dim finalDbKey As String = "DB1" ' Identificador de la base de datos, con valor por defecto "DB1". Dim finalDbKey As String = "DB1" ' Database identifier, defaulting to "DB1".
Dim requestsBeforeDecrement As Int = 0 ' Contador de peticiones activas antes de decrementar, inicializado en 0. Dim requestsBeforeDecrement As Int = 0 ' Active request counter before decrementing, initialized to 0.
Dim Total As Int = 0 Dim Total As Int = 0
Try ' --- INICIO: Bloque Try que envuelve la lógica principal del Handler --- Try ' --- START: Try block wrapping the main Handler logic ---
Dim jsonString As String Dim jsonString As String
' <<<< INICIO: Lógica para manejar peticiones POST con JSON en el cuerpo >>>> ' Logic to handle POST requests with JSON in the body
If req.Method = "POST" And req.ContentType.Contains("application/json") Then If req.Method = "POST" And req.ContentType.Contains("application/json") Then
' Si es un POST con JSON en el cuerpo, leemos directamente del InputStream. ' If it's a POST with JSON in the body, read directly from the InputStream.
Dim Is0 As InputStream = req.InputStream Dim Is0 As InputStream = req.InputStream
Dim bytes() As Byte = Bit.InputStreamToBytes(Is0) ' Lee el cuerpo completo de la petición. Dim bytes() As Byte = Bit.InputStreamToBytes(Is0) ' Read the entire request body.
jsonString = BytesToString(bytes, 0, bytes.Length, "UTF8") ' Convierte los bytes a una cadena JSON. jsonString = BytesToString(bytes, 0, bytes.Length, "UTF8") ' Convert bytes to a JSON string.
Is0.Close ' Cierra explícitamente el InputStream para liberar recursos. Is0.Close ' Explicitly close the InputStream to free resources.
Else Else
' De lo contrario, asumimos que el JSON viene en el parámetro 'j' de la URL (método legacy/GET). ' Otherwise, assume the JSON comes in the 'j' parameter of the URL (legacy/GET method).
jsonString = req.GetParameter("j") jsonString = req.GetParameter("j")
End If End If
' <<<< FIN: Lógica para manejar peticiones POST con JSON en el cuerpo >>>>
' Validación inicial: Si no hay JSON, se envía un error 400. ' Initial validation: If there is no JSON, send a 400 error.
If jsonString = Null Or jsonString = "" Then If jsonString = Null Or jsonString = "" Then
Dim ErrorMsg As String = "Falta el parámetro 'j' en el URL o el cuerpo JSON en la petición." Dim ErrorMsg As String = "Falta el parámetro 'j' en el URL o el cuerpo JSON en la petición."
SendErrorResponse(resp, 400, ErrorMsg) SendErrorResponse(resp, 400, ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress)
duration = DateTime.Now - start duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return Return
End If End If
Dim parser As JSONParser Dim parser As JSONParser
parser.Initialize(jsonString) ' Inicializa el parser JSON con la cadena recibida. parser.Initialize(jsonString) ' Initialize the JSON parser with the received string.
Dim RootMap As Map = parser.NextObject ' Parsea el JSON a un objeto Map. Dim RootMap As Map = parser.NextObject ' Parse the JSON into a Map object.
Dim execType As String = RootMap.GetDefault("exec", "") ' Obtiene el tipo de ejecución (ej. "ExecuteQuery"). Dim execType As String = RootMap.GetDefault("exec", "") ' Get the execution type (e.g., "ExecuteQuery").
' Obtiene el nombre de la query. Si no está en "query", busca en "exec". ' Get the query name. If not in "query", look in "exec".
queryNameForLog = RootMap.GetDefault("query", "") queryNameForLog = RootMap.GetDefault("query", "")
If queryNameForLog = "" Then queryNameForLog = RootMap.GetDefault("exec", "unknown_json_command") If queryNameForLog = "" Then queryNameForLog = RootMap.GetDefault("exec", "unknown_json_command")
Dim paramsList As List = RootMap.Get("params") ' Obtiene la lista de parámetros para la query. Dim paramsList As List = RootMap.Get("params") ' Get the list of parameters for the query.
If paramsList = Null Or paramsList.IsInitialized = False Then If paramsList = Null Or paramsList.IsInitialized = False Then
paramsList.Initialize ' Si no hay parámetros, inicializa una lista vacía. paramsList.Initialize ' If no parameters, initialize an empty list.
End If End If
' <<<< ¡CORRECCIÓN CLAVE: RESOLVEMOS finalDbKey del JSON ANTES de usarla para los contadores! >>>> ' Resolve finalDbKey from the JSON BEFORE using it for counters.
' Esto asegura que el contador y el conector usen la DB correcta. ' This ensures the counter and connector use the correct DB.
If RootMap.Get("dbx") <> Null Then finalDbKey = RootMap.Get("dbx") If RootMap.Get("dbx") <> Null Then finalDbKey = RootMap.Get("dbx")
' <<<< ¡FIN DE CORRECCIÓN CLAVE! >>>>
' --- INICIO: Conteo de peticiones activas para esta finalDbKey (Incrementar) --- ' --- START: Active request count for this finalDbKey (Increment) ---
' Este bloque incrementa un contador global que rastrea cuántas peticiones están ' This block increments a global counter tracking how many requests
' activas para una base de datos específica en un momento dado. ' are active for a specific database at any given time.
' 1. Aseguramos que el valor inicial sea un Int y lo recuperamos como Int (usando .As(Int)). ' 1. Ensure the initial value is an Int and retrieve it as Int (using .As(Int)).
Dim currentCountFromMap As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(finalDbKey, 0).As(Int) Dim currentCountFromMap As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(finalDbKey, 0).As(Int)
GlobalParameters.ActiveRequestsCountByDB.Put(finalDbKey, currentCountFromMap + 1) GlobalParameters.ActiveRequestsCountByDB.Put(finalDbKey, currentCountFromMap + 1)
' requestsBeforeDecrement es el valor del contador justo después de que esta petición lo incrementa. ' requestsBeforeDecrement is the counter value right after this request increments it.
' Este es el valor que se registrará en la tabla 'query_logs'. ' This is the value that will be recorded in the 'query_logs' table.
requestsBeforeDecrement = currentCountFromMap + 1 requestsBeforeDecrement = currentCountFromMap + 1
' Los logs de depuración para el incremento del contador pueden ser descomentados para una depuración profunda. ' --- END: Active request count ---
' Log($"[DEBUG] Handle Increment (JSON): dbKey=${finalDbKey}, currentCountFromMap=${currentCountFromMap}, requestsBeforeDecrement=${requestsBeforeDecrement}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' --- FIN: Conteo de peticiones activas ---
' Inicializa el Connector con la finalDbKey resuelta. ' Initialize the Connector with the resolved finalDbKey.
Connector = Main.Connectors.Get(finalDbKey) Connector = Main.Connectors.Get(finalDbKey)
' Validación: Si el dbKey no es válido o no está configurado en Main.listaDeCP. ' Validation: If the dbKey is invalid or not configured in Main.listaDeCP.
If Main.listaDeCP.IndexOf(finalDbKey) = -1 Then If Main.listaDeCP.IndexOf(finalDbKey) = -1 Then
Dim ErrorMsg As String = "Parámetro 'DB' inválido. El nombre '" & finalDbKey & "' no es válido." Dim ErrorMsg As String = "Parámetro 'DB' inválido. El nombre '" & finalDbKey & "' no es válido."
SendErrorResponse(resp, 400, ErrorMsg) SendErrorResponse(resp, 400, ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress)
duration = DateTime.Now - start duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return Return
End If End If
con = Connector.GetConnection(finalDbKey) ' ¡La conexión a la BD se obtiene aquí del pool de conexiones! con = Connector.GetConnection(finalDbKey) ' The DB connection is obtained here from the connection pool!
' <<<< ¡CAPTURAMOS BUSY_CONNECTIONS INMEDIATAMENTE DESPUÉS DE OBTENER LA CONEXIÓN! >>>> ' Capture BUSY_CONNECTIONS IMMEDIATELY AFTER getting the connection.
' Este bloque captura el número de conexiones actualmente ocupadas en el pool ' This block captures the number of connections currently busy in the pool
' *después* de que esta petición ha obtenido la suya. ' *after* this request has obtained its own.
If Connector.IsInitialized Then If Connector.IsInitialized Then
Dim poolStats As Map = Connector.GetPoolStats Dim poolStats As Map = Connector.GetPoolStats
If poolStats.ContainsKey("BusyConnections") Then If poolStats.ContainsKey("BusyConnections") Then
' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que el valor sea Int! >>>> ' Ensure the value is Int!
poolBusyConnectionsForLog = poolStats.Get("BusyConnections").As(Int) ' Capturamos el valor. poolBusyConnectionsForLog = poolStats.Get("BusyConnections").As(Int) ' We capture the value.
' Log($">>>>>>>>>> ${poolStats.Get("BusyConnections")} "$) ' Log($">>>>>>>>>> ${poolStats.Get("BusyConnections")} "$)
End If End If
End If End If
' <<<< ¡FIN DE CAPTURA! >>>>
Dim cachedStatsJSON As Map = Main.LatestPoolStats.Get(finalDbKey).As(Map) Dim cachedStatsJSON As Map = Main.LatestPoolStats.Get(finalDbKey).As(Map)
If cachedStatsJSON.IsInitialized Then If cachedStatsJSON.IsInitialized Then
' Los valores ya fueron capturados: poolBusyConnectionsForLog y requestsBeforeDecrement ' Values were already captured: poolBusyConnectionsForLog and requestsBeforeDecrement
cachedStatsJSON.Put("BusyConnections", poolBusyConnectionsForLog) cachedStatsJSON.Put("BusyConnections", poolBusyConnectionsForLog)
cachedStatsJSON.Put("HandlerActiveRequests", requestsBeforeDecrement) cachedStatsJSON.Put("HandlerActiveRequests", requestsBeforeDecrement)
If poolStats.ContainsKey("TotalConnections") Then If poolStats.ContainsKey("TotalConnections") Then
@@ -145,167 +140,161 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
If poolStats.ContainsKey("IdleConnections") Then If poolStats.ContainsKey("IdleConnections") Then
cachedStatsJSON.Put("IdleConnections", poolStats.Get("IdleConnections")) cachedStatsJSON.Put("IdleConnections", poolStats.Get("IdleConnections"))
End If End If
' Re-escribir el mapa en el cache global (es Thread-Safe) ' Re-write the map to the global cache (it's Thread-Safe)
Main.LatestPoolStats.Put(finalDbKey, cachedStatsJSON) Main.LatestPoolStats.Put(finalDbKey, cachedStatsJSON)
' Log(Main.LatestPoolStats) ' Log(Main.LatestPoolStats)
End If End If
' Log($"Total: ${poolStats.Get("TotalConnections")}, Idle: ${poolStats.Get("IdleConnections")}, busy: ${poolBusyConnectionsForLog}, active: ${requestsBeforeDecrement}"$) ' Log($"Total: ${poolStats.Get("TotalConnections")}, Idle: ${poolStats.Get("IdleConnections")}, busy: ${poolBusyConnectionsForLog}, active: ${requestsBeforeDecrement}"$)
' Obtiene la sentencia SQL correspondiente al nombre del comando desde config.properties. ' Get the SQL statement corresponding to the command name from config.properties.
Dim sqlCommand As String = Connector.GetCommand(finalDbKey, queryNameForLog) Dim sqlCommand As String = Connector.GetCommand(finalDbKey, queryNameForLog)
' Validación: Si el comando SQL no fue encontrado en la configuración. ' Validation: If the SQL command was not found in the configuration.
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
Dim errorMessage As String = $"El comando '${queryNameForLog}' no fue encontrado en el config.properties de '${finalDbKey}'."$ Dim errorMessage As String = $"El comando '${queryNameForLog}' no fue encontrado en el config.properties de '${finalDbKey}'."$
Log(errorMessage) Log(errorMessage)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", errorMessage, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log Main.LogServerError("ERROR", "DBHandlerJSON.Handle", errorMessage, finalDbKey, queryNameForLog, req.RemoteAddress)
SendErrorResponse(resp, 400, errorMessage) SendErrorResponse(resp, 400, errorMessage)
duration = DateTime.Now - start duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return Return
End If End If
' --- Lógica para ejecutar diferentes tipos de comandos basados en el parámetro 'execType' --- ' Logic to execute different command types based on the 'execType' parameter
If execType.ToLowerCase = "executequery" Then If execType.ToLowerCase = "executequery" Then
' --- INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA --- ' --- START CENTRALIZED PARAMETER VALIDATION ---
Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryNameForLog, finalDbKey, sqlCommand, paramsList, Connector.IsParameterToleranceEnabled) Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryNameForLog, finalDbKey, sqlCommand, paramsList, Connector.IsParameterToleranceEnabled)
If validationResult.Success = False Then If validationResult.Success = False Then
SendErrorResponse(resp, 400, validationResult.ErrorMessage) SendErrorResponse(resp, 400, validationResult.ErrorMessage)
duration = DateTime.Now - start duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return ' Salida temprana. Return ' Early exit.
End If End If
Dim rs As ResultSet Dim rs As ResultSet
' Ejecuta la consulta SQL con la lista de parámetros validada. ' Execute the SQL query with the validated parameter list.
rs = con.ExecQuery2(sqlCommand, validationResult.ParamsToExecute) rs = con.ExecQuery2(sqlCommand, validationResult.ParamsToExecute)
' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA --- ' --- END CENTRALIZED PARAMETER VALIDATION ---
Dim ResultList As List Dim ResultList As List
ResultList.Initialize ' Lista para almacenar los resultados de la consulta. ResultList.Initialize ' List to store query results.
Dim jrs As JavaObject = rs ' Objeto Java subyacente del ResultSet para metadatos. Dim jrs As JavaObject = rs ' Underlying Java object of the ResultSet for metadata.
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) ' Metadatos del ResultSet. Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) ' ResultSet metadata.
Dim cols As Int = rsmd.RunMethod("getColumnCount", Null) ' Número de columnas. Dim cols As Int = rsmd.RunMethod("getColumnCount", Null) ' Number of columns.
Do While rs.NextRow ' Itera sobre cada fila del resultado. Do While rs.NextRow ' Iterate over each row in the result.
Dim RowMap As Map Dim RowMap As Map
RowMap.Initialize ' Mapa para almacenar los datos de la fila actual. RowMap.Initialize ' Map to store the current row's data.
For i = 1 To cols ' Itera sobre cada columna. For i = 1 To cols ' Iterate over each column.
Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i)) ' Nombre de la columna. Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i)) ' Column name.
Dim value As Object = jrs.RunMethod("getObject", Array(i)) ' Valor de la columna. Dim value As Object = jrs.RunMethod("getObject", Array(i)) ' Column value.
RowMap.Put(ColumnName, value) ' Añade la columna y su valor al mapa de la fila. RowMap.Put(ColumnName, value) ' Add the column and its value to the row map.
Next Next
ResultList.Add(RowMap) ' Añade el mapa de la fila a la lista de resultados. ResultList.Add(RowMap) ' Add the row map to the results list.
Loop Loop
rs.Close ' Cierra el ResultSet. rs.Close ' Close the ResultSet.
SendSuccessResponse(resp, CreateMap("result": ResultList)) ' Envía la respuesta JSON de éxito. SendSuccessResponse(resp, CreateMap("result": ResultList)) ' Send the success JSON response.
Else If execType.ToLowerCase = "executecommand" Then Else If execType.ToLowerCase = "executecommand" Then
' --- INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA --- ' --- START CENTRALIZED PARAMETER VALIDATION ---
Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryNameForLog, finalDbKey, sqlCommand, paramsList, Connector.IsParameterToleranceEnabled) Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryNameForLog, finalDbKey, sqlCommand, paramsList, Connector.IsParameterToleranceEnabled)
If validationResult.Success = False Then If validationResult.Success = False Then
SendErrorResponse(resp, 400, validationResult.ErrorMessage) SendErrorResponse(resp, 400, validationResult.ErrorMessage)
duration = DateTime.Now - start duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return ' Salida temprana. Return ' Early exit.
End If End If
Dim affectedCount As Int = 1 ' Asumimos éxito (1) si ExecNonQuery2 no lanza una excepción. Dim affectedCount As Int = 1 ' Assume success (1) if ExecNonQuery2 doesn't throw an exception.
con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Ejecuta un comando con la lista de parámetros validada. con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Execute a command with the validated parameter list.
SendSuccessResponse(resp, CreateMap("affectedRows": affectedCount, "message": "Command executed successfully")) ' Envía confirmación de éxito. SendSuccessResponse(resp, CreateMap("affectedRows": affectedCount, "message": "Command executed successfully")) ' Send success confirmation.
' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA --- ' --- END CENTRALIZED PARAMETER VALIDATION ---
Else Else
Dim ErrorMsg As String = "Parámetro 'exec' inválido. '" & execType & "' no es un valor permitido." Dim ErrorMsg As String = "Parámetro 'exec' inválido. '" & execType & "' no es un valor permitido."
SendErrorResponse(resp, 400, ErrorMsg) SendErrorResponse(resp, 400, ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress)
' El flujo continúa hasta la limpieza final si no hay un Return explícito. ' Flow continues to final cleanup if there is no explicit Return.
End If End If
Catch ' --- CATCH: Maneja errores generales de ejecución o de SQL/JSON --- Catch ' --- CATCH: Handle general execution or SQL/JSON errors ---
Log(LastException) ' Registra la excepción completa en el log. Log(LastException) ' Log the full exception.
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", LastException.Message, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log Main.LogServerError("ERROR", "DBHandlerJSON.Handle", LastException.Message, finalDbKey, queryNameForLog, req.RemoteAddress)
SendErrorResponse(resp, 500, LastException.Message) ' Envía un error 500 al cliente. SendErrorResponse(resp, 500, LastException.Message) ' Send a 500 error to the client.
queryNameForLog = "error_processing_json" ' Para registrar que hubo un error en el log. queryNameForLog = "error_processing_json" ' To log that there was an error.
End Try ' --- FIN: Bloque Try principal --- End Try ' --- END: Main Try block ---
' --- Lógica de logging y limpieza final (para rutas de ejecución normal o después de Catch) --- ' --- Final logging and cleanup logic (for normal execution paths or after Catch) ---
' Este bloque se asegura de que, independientemente de cómo termine la petición (éxito o error), ' This block ensures that, regardless of how the request ends (success or error),
' la duración se calcule y se llamen las subrutinas de limpieza y logging. ' the duration is calculated and the cleanup and logging subs are called.
duration = DateTime.Now - start ' Calcula la duración total de la petición. duration = DateTime.Now - start ' Calculate the total request duration.
' Llama a la subrutina centralizada para registrar el rendimiento y limpiar recursos. ' Call the centralized subroutine to log performance and clean up resources.
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
End Sub End Sub
' --- NUEVA SUBRUTINA: Centraliza el logging de rendimiento y la limpieza de recursos --- ' --- Subroutine: Centralizes performance logging and resource cleanup ---
' Esta subrutina es llamada por Handle en todos los puntos de salida, asegurando ' This subroutine is called by Handle at all exit points, ensuring
' que los contadores se decrementen y las conexiones se cierren de forma consistente. ' that counters are decremented and connections are closed consistently.
Private Sub CleanupAndLog(dbKey As String, qName As String, durMs As Long, clientIp As String, handlerReqs As Int, poolBusyConns As Int, conn As SQL) Private Sub CleanupAndLog(dbKey As String, qName As String, durMs As Long, clientIp As String, handlerReqs As Int, poolBusyConns As Int, conn As SQL)
' Los logs de depuración para CleanupAndLog pueden ser descomentados para una depuración profunda. ' 1. Call the centralized subroutine in Main to log performance to SQLite.
' Log($"[DEBUG] CleanupAndLog Entry (JSON): dbKey=${dbKey}, handlerReqs=${handlerReqs}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' 1. Llama a la subrutina centralizada en Main para registrar el rendimiento en SQLite.
Main.LogQueryPerformance(qName, durMs, dbKey, clientIp, handlerReqs, poolBusyConns) Main.LogQueryPerformance(qName, durMs, dbKey, clientIp, handlerReqs, poolBusyConns)
' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que currentCount sea Int al obtenerlo del mapa! >>>> ' 2. Robustly decrement the active request counter for this dbKey.
' 2. Decrementa el contador de peticiones activas para esta dbKey de forma robusta.
Dim currentCount As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey, 0).As(Int) Dim currentCount As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey, 0).As(Int)
' Log($"[DEBUG] CleanupAndLog Before Decrement (JSON): dbKey=${dbKey}, currentCount (as Int)=${currentCount}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
If currentCount > 0 Then If currentCount > 0 Then
' Si el contador es positivo, lo decrementamos. ' If the counter is positive, decrement it.
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, currentCount - 1) GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, currentCount - 1)
Else Else
' Si el contador ya está en 0 o negativo (lo cual no debería ocurrir con la lógica actual, ' If the counter is already 0 or negative (which shouldn't happen with current logic,
' pero se maneja para robustez), registramos una advertencia y lo aseguramos en 0. ' but is handled for robustness), we log a warning and ensure it is 0.
' Log($"ADVERTENCIA: Intento de decrementar ActiveRequestsCountByDB para ${dbKey} que ya estaba en ${currentCount}. Asegurando a 0."$) ' Log($"ADVERTENCIA: Intento de decrementar ActiveRequestsCountByDB para ${dbKey} que ya estaba en ${currentCount}. Asegurando a 0."$)
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, 0) GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, 0)
End If End If
' Log($"[DEBUG] CleanupAndLog After Decrement (JSON): dbKey=${dbKey}, New count (as Int)=${GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey,0).As(Int)}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' <<<< ¡FIN DE CORRECCIÓN CLAVE! >>>>
' 3. Asegura que la conexión a la BD siempre se cierre y se devuelva al pool de conexiones. ' 3. Ensure the DB connection is always closed and returned to the connection pool.
If conn <> Null And conn.IsInitialized Then conn.Close If conn <> Null And conn.IsInitialized Then conn.Close
End Sub End Sub
' --- Subrutinas de ayuda para respuestas JSON --- ' --- Helper subroutines for JSON responses ---
' Construye y envía una respuesta JSON de éxito. ' Builds and sends a success JSON response.
' resp: El objeto ServletResponse para enviar la respuesta. ' resp: The ServletResponse object to send the response.
' dataMap: Un mapa que contiene los datos a incluir en la respuesta JSON. ' dataMap: A map containing the data to include in the JSON response.
Private Sub SendSuccessResponse(resp As ServletResponse, dataMap As Map) Private Sub SendSuccessResponse(resp As ServletResponse, dataMap As Map)
' Añade el campo "success": true al mapa de datos para indicar que todo salió bien. ' Add the "success": true field to the data map to indicate everything went well.
dataMap.Put("success", True) dataMap.Put("success", True)
' Crea un generador de JSON. ' Create a JSON generator.
Dim jsonGenerator As JSONGenerator Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(dataMap) jsonGenerator.Initialize(dataMap)
' Establece el tipo de contenido de la respuesta a "application/json". ' Set the response content type to "application/json".
resp.ContentType = "application/json" resp.ContentType = "application/json"
' Escribe la cadena JSON generada en el cuerpo de la respuesta HTTP. ' Write the generated JSON string to the HTTP response body.
resp.Write(jsonGenerator.ToString) resp.Write(jsonGenerator.ToString)
End Sub End Sub
' Construye y envía una respuesta JSON de error. ' Builds and sends an error JSON response.
' resp: El objeto ServletResponse para enviar la respuesta. ' resp: The ServletResponse object to send the response.
' statusCode: El código de estado HTTP (ej. 400 para error del cliente, 500 para error del servidor). ' statusCode: The HTTP status code (e.g., 400 for client error, 500 for server error).
' errorMessage: El mensaje de error que se enviará al cliente. ' errorMessage: The error message to be sent to the client.
Private Sub SendErrorResponse(resp As ServletResponse, statusCode As Int, errorMessage As String) Private Sub SendErrorResponse(resp As ServletResponse, statusCode As Int, errorMessage As String)
' Personaliza el mensaje de error si es un error común de parámetros de Oracle o JDBC. ' Customize the error message if it's a common Oracle or JDBC parameter error.
If errorMessage.Contains("Índice de columnas no válido") Or errorMessage.Contains("ORA-17003") Then If errorMessage.Contains("Índice de columnas no válido") Or errorMessage.Contains("ORA-17003") Then
errorMessage = "NUMERO DE PARAMETROS EQUIVOCADO: " & errorMessage errorMessage = "NUMERO DE PARAMETROS EQUIVOCADO: " & errorMessage
End If End If
' Crea un mapa con el estado de error y el mensaje. ' Create a map with the error status and message.
Dim resMap As Map = CreateMap("success": False, "error": errorMessage) Dim resMap As Map = CreateMap("success": False, "error": errorMessage)
' Genera la cadena JSON a partir del mapa. ' Generate the JSON string from the map.
Dim jsonGenerator As JSONGenerator Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(resMap) jsonGenerator.Initialize(resMap)
' Establece el código de estado HTTP (ej. 400 para error del cliente, 500 para error del servidor). ' Set the HTTP status code (e.g., 400 for client error, 500 for server error).
resp.Status = statusCode resp.Status = statusCode
' Establece el tipo de contenido y escribe la respuesta de error. ' Set the content type and write the error response.
resp.ContentType = "application/json" resp.ContentType = "application/json"
resp.Write(jsonGenerator.ToString) resp.Write(jsonGenerator.ToString)
End Sub End Sub

9
DoLoginHandler.bas
View File

@@ -19,18 +19,15 @@ Public Sub Handle(req As ServletRequest, resp As ServletResponse)
Dim p As String = req.GetParameter("password") Dim p As String = req.GetParameter("password")
Log(u) Log(u)
Try Try
' Buscamos el hash en la base de datos usando el usuario limpio ' Buscamos el hash en la base de datos de autenticación (SQL_Auth)
Dim storedHash As String = Main.SQL1.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(u)) Dim storedHash As String = Main.SQL_Auth.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(u))
Log($"${storedHash}"$) Log($"${storedHash}"$)
' Log($"${bc.checkpw(p, storedHash)}"$)
' Verificamos la contraseña contra el hash ' Verificamos la contraseña contra el hash
If storedHash <> Null And bc.checkpw(p, storedHash) Then If storedHash <> Null And bc.checkpw(p, storedHash) Then
' CREDENCIALES CORRECTAS ' CREDENCIALES CORRECTAS
' 1. Autorizamos la sesión
req.GetSession.SetAttribute("user_is_authorized", True) req.GetSession.SetAttribute("user_is_authorized", True)
' 2. ¡Y guardamos el nombre de usuario! (Esta es la línea que faltaba)
req.GetSession.SetAttribute("username", u) req.GetSession.SetAttribute("username", u)
resp.SendRedirect("/manager") resp.SendRedirect("/manager")
Else Else
' Credenciales incorrectas ' Credenciales incorrectas

966
Files/www/manager.html
View File

File diff suppressed because it is too large Load Diff

138
HikariConnectionPool.bas
View File

@@ -4,7 +4,7 @@ ModulesStructureVersion=1
Type=Class Type=Class
Version=6.01 Version=6.01
@EndOfDesignText@ @EndOfDesignText@
'Class module 'Class module : HikariConnectionPool
'Author: Oliver Ackermann 'Author: Oliver Ackermann
'Created on: 2018/05/07 'Created on: 2018/05/07
'Based on: https://github.com/AnywhereSoftware/B4J_Server/blob/master/src/anywheresoftware/b4j/object/ConnectionPool.java 'Based on: https://github.com/AnywhereSoftware/B4J_Server/blob/master/src/anywheresoftware/b4j/object/ConnectionPool.java
@@ -27,7 +27,7 @@ End Sub
Public Sub Initialize Public Sub Initialize
Dim properties As Map Dim properties As Map
properties.Initialize properties.Initialize
'
'Frequently used 'Frequently used
properties.Put("autocommit", "boolean") properties.Put("autocommit", "boolean")
properties.Put("connectiontimeout", "int") properties.Put("connectiontimeout", "int")
@@ -73,7 +73,6 @@ Public Sub CreatePool2(driverClass As String, jdbcUrl As String, aUser As String
poolJO.RunMethod("setUsername", Array As Object(aUser)) poolJO.RunMethod("setUsername", Array As Object(aUser))
poolJO.RunMethod("setPassword", Array As Object(aPassword)) poolJO.RunMethod("setPassword", Array As Object(aPassword))
If poolSize > 0 Then poolJO.RunMethod("setMaximumPoolSize", Array As Object(poolSize)) If poolSize > 0 Then poolJO.RunMethod("setMaximumPoolSize", Array As Object(poolSize))
End Sub End Sub
Public Sub CreatePool3(options As Map) Public Sub CreatePool3(options As Map)
@@ -85,7 +84,7 @@ End Sub
'that HikariConfig object. 'that HikariConfig object.
Public Sub SetProperties(properties As Map) Public Sub SetProperties(properties As Map)
' Valores óptimos por defecto para HikariCP (en milisegundos) ' Optimal default values for HikariCP (in milliseconds)
Private const DEFAULT_MAX_LIFE As Long = 1750000 Private const DEFAULT_MAX_LIFE As Long = 1750000
Private const DEFAULT_CONN_TIMEOUT As Long = 30000 Private const DEFAULT_CONN_TIMEOUT As Long = 30000
Private const DEFAULT_LEAK_THR As Long = 35000 Private const DEFAULT_LEAK_THR As Long = 35000
@@ -93,112 +92,105 @@ Public Sub SetProperties(properties As Map)
Private const DEFAULT_MIN_IDLE As Int = 10 Private const DEFAULT_MIN_IDLE As Int = 10
Private const DEFAULT_MAX_SIZE As Int = 10 Private const DEFAULT_MAX_SIZE As Int = 10
Private const DEFAULT_KEEP_ALIVE_TIME As Long = 300000 Private const DEFAULT_KEEP_ALIVE_TIME As Long = 300000
Dim rawValue As String Dim rawValue As String
Dim processedKeys As List Dim processedKeys As List
processedKeys.Initialize processedKeys.Initialize
Dim maxSize As Int ' Variable temporal para el tamaño máximo calculado Dim maxSize As Int ' Temporary variable for the calculated maximum size
' --- INICIO: Procesamiento de Propiedades Críticas --- ' 1. MaxLifetime (Long) - Key: maxlifetime
' 1. MaxLifetime (Long) - Clave: maxlifetime
Dim maxLife As Long Dim maxLife As Long
If properties.ContainsKey("maxlifetime") Then If properties.ContainsKey("maxlifetime") Then
rawValue = properties.Get("maxlifetime").As(String).Trim rawValue = properties.Get("maxlifetime").As(String).Trim
maxLife = rawValue maxLife = rawValue
poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife)) poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife))
Log($"Ponemos (LONG, Config): MaxLifetime, ${maxLife}"$) Log($"Ponemos MaxLifetime: ${maxLife}"$)
Else Else
maxLife = DEFAULT_MAX_LIFE maxLife = DEFAULT_MAX_LIFE
poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife)) poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife))
Log($"Ponemos (LONG, Default): MaxLifetime, ${DEFAULT_MAX_LIFE}"$) Log($"Ponemos (LONG, Default): MaxLifetime, ${DEFAULT_MAX_LIFE}"$)
End If End If
processedKeys.Add("maxlifetime") processedKeys.Add("maxlifetime")
MaxLifeConfig = maxLife ' <-- ALMACENAMIENTO CRÍTICO MaxLifeConfig = maxLife ' Store the config value
' 2. ConnectionTimeout (Long) - Clave: connectiontimeout ' 2. ConnectionTimeout (Long) - Key: connectiontimeout
Dim connTimeout As Long Dim connTimeout As Long
If properties.ContainsKey("connectiontimeout") Then If properties.ContainsKey("connectiontimeout") Then
rawValue = properties.Get("connectiontimeout").As(String).Trim rawValue = properties.Get("connectiontimeout").As(String).Trim
connTimeout = rawValue connTimeout = rawValue
poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout)) poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout))
Log($"Ponemos (LONG, Config): ConnectionTimeout, ${connTimeout}"$) Log($"Ponemos ConnectionTimeout: ${connTimeout}"$)
Else Else
connTimeout = DEFAULT_CONN_TIMEOUT connTimeout = DEFAULT_CONN_TIMEOUT
poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout)) poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout))
Log($"Ponemos (LONG, Default): ConnectionTimeout, ${DEFAULT_CONN_TIMEOUT}"$) Log($"Ponemos ConnectionTimeout: ${DEFAULT_CONN_TIMEOUT}"$)
End If End If
processedKeys.Add("connectiontimeout") processedKeys.Add("connectiontimeout")
ConnTimeoutConfig = connTimeout ' <-- ALMACENAMIENTO CRÍTICO ConnTimeoutConfig = connTimeout ' Store the config value
' 3. LeakDetectionThreshold (Long) - Clave: leakdetectionthreshold ' 3. LeakDetectionThreshold (Long) - Key: leakdetectionthreshold
Dim leakThr As Long Dim leakThr As Long
If properties.ContainsKey("leakdetectionthreshold") Then If properties.ContainsKey("leakdetectionthreshold") Then
rawValue = properties.Get("leakdetectionthreshold").As(String).Trim rawValue = properties.Get("leakdetectionthreshold").As(String).Trim
leakThr = rawValue leakThr = rawValue
poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr)) poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr))
Log($"Ponemos (LONG, Config): LeakDetectionThreshold, ${leakThr}"$) Log($"Ponemos LeakDetectionThreshold: ${leakThr}"$)
Else Else
leakThr = DEFAULT_LEAK_THR leakThr = DEFAULT_LEAK_THR
poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr)) poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr))
Log($"Ponemos (LONG, Default): LeakDetectionThreshold, ${DEFAULT_LEAK_THR}"$) Log($"Ponemos (LONG, Default): LeakDetectionThreshold, ${DEFAULT_LEAK_THR}"$)
End If End If
processedKeys.Add("leakdetectionthreshold") processedKeys.Add("leakdetectionthreshold")
LeakDetectionThresholdConfig = leakThr ' <-- ALMACENAMIENTO CRÍTICO LeakDetectionThresholdConfig = leakThr ' Store the config value
' 4. MaximumPoolSize (Int) - Key: maximumpoolsize
' ********** LÓGICA DE FIXED POOL: MaximumPoolSize primero **********
' 4. MaximumPoolSize (Int) - Clave: maximumpoolsize
If properties.ContainsKey("maximumpoolsize") Then If properties.ContainsKey("maximumpoolsize") Then
rawValue = properties.Get("maximumpoolsize").As(String).Trim rawValue = properties.Get("maximumpoolsize").As(String).Trim
maxSize = rawValue.As(Int) maxSize = rawValue.As(Int)
poolJO.RunMethod("setMaximumPoolSize", Array As Object(maxSize)) poolJO.RunMethod("setMaximumPoolSize", Array As Object(maxSize))
Log($"Ponemos (INT, Config): MaximumPoolSize, ${maxSize}"$) Log($"Ponemos MaximumPoolSize: ${maxSize}"$)
Else Else
maxSize = DEFAULT_MAX_SIZE maxSize = DEFAULT_MAX_SIZE
poolJO.RunMethod("setMaximumPoolSize", Array As Object(DEFAULT_MAX_SIZE)) poolJO.RunMethod("setMaximumPoolSize", Array As Object(DEFAULT_MAX_SIZE))
Log($"Ponemos (INT, Default): MaximumPoolSize, ${DEFAULT_MAX_SIZE}"$) Log($"Ponemos MaximumPoolSize: ${DEFAULT_MAX_SIZE}"$)
End If End If
processedKeys.Add("maximumpoolsize") processedKeys.Add("maximumpoolsize")
PoolSizeConfig = maxSize ' <-- ALMACENAMIENTO CRÍTICO PoolSizeConfig = maxSize ' Store the config value
' 5. MinimumIdle (Int) - Clave: minimumidle ' 5. MinimumIdle (Int) - Key: minimumidle
Dim minIdleFinal As Int Dim minIdleFinal As Int
If properties.ContainsKey("minimumidle") Then If properties.ContainsKey("minimumidle") Then
rawValue = properties.Get("minimumidle").As(String).Trim rawValue = properties.Get("minimumidle").As(String).Trim
minIdleFinal = rawValue.As(Int) minIdleFinal = rawValue.As(Int)
poolJO.RunMethod("setMinimumIdle", Array As Object(minIdleFinal)) poolJO.RunMethod("setMinimumIdle", Array As Object(minIdleFinal))
Log($"Ponemos (INT, Config): MinimumIdle, ${minIdleFinal}"$) Log($"Ponemos MinimumIdle: ${minIdleFinal}"$)
Else Else
' APLICAMOS EL FIXED POOL AXIOM: MinimumIdle = MaximumPoolSize (maxSize) ' APPLY FIXED POOL AXIOM: MinimumIdle = MaximumPoolSize (maxSize)
minIdleFinal = maxSize minIdleFinal = maxSize
poolJO.RunMethod("setMinimumIdle", Array As Object(minIdleFinal)) poolJO.RunMethod("setMinimumIdle", Array As Object(minIdleFinal))
Log($"Ponemos (INT, Fixed Default): MinimumIdle, ${minIdleFinal} (Igual a MaximumPoolSize)"$) Log($"Ponemos MinimumIdle: ${minIdleFinal} (Igual a MaximumPoolSize)"$)
End If End If
processedKeys.Add("minimumidle") processedKeys.Add("minimumidle")
MinIdleConfig = minIdleFinal ' <-- ALMACENAMIENTO CRÍTICO MinIdleConfig = minIdleFinal ' Store the config value
' ********** FIN DE LA LÓGICA DE FIXED POOL ********** ' 6. RegisterMbeans (Boolean) - Key: registermbeans
' 6. RegisterMbeans (Boolean) - Clave: registermbeans
If properties.ContainsKey("registermbeans") Then If properties.ContainsKey("registermbeans") Then
Dim regMbeans As Boolean = properties.Get("registermbeans") Dim regMbeans As Boolean = properties.Get("registermbeans")
poolJO.RunMethod("setRegisterMbeans", Array As Object(regMbeans)) poolJO.RunMethod("setRegisterMbeans", Array As Object(regMbeans))
Log($"Ponemos (BOOL, Config): RegisterMbeans, ${regMbeans}"$) Log($"Ponemos RegisterMbeans: ${regMbeans}"$)
Else Else
poolJO.RunMethod("setRegisterMbeans", Array As Object(DEFAULT_REG_MBEANS)) poolJO.RunMethod("setRegisterMbeans", Array As Object(DEFAULT_REG_MBEANS))
Log($"Ponemos (BOOL, Default): RegisterMbeans, ${DEFAULT_REG_MBEANS}"$) Log($"Ponemos RegisterMbeans: ${DEFAULT_REG_MBEANS}"$)
End If End If
processedKeys.Add("registermbeans") processedKeys.Add("registermbeans")
' 7. KeepaliveTime (Long) - Clave: keepalivetime ' 7. KeepaliveTime (Long) - Key: keepalivetime
Dim keepAlive As Long Dim keepAlive As Long
If properties.ContainsKey("keepalivetime") Then If properties.ContainsKey("keepalivetime") Then
rawValue = properties.Get("keepalivetime").As(String).Trim rawValue = properties.Get("keepalivetime").As(String).Trim
keepAlive = rawValue keepAlive = rawValue
' El valor mínimo aceptado es 30,000 ms [4]. ' The minimum accepted value is 30,000 ms [4].
If keepAlive < 30000 Then keepAlive = 30000 If keepAlive < 30000 Then keepAlive = 30000
poolJO.RunMethod("setKeepaliveTime", Array As Object(keepAlive)) poolJO.RunMethod("setKeepaliveTime", Array As Object(keepAlive))
@@ -206,13 +198,12 @@ Public Sub SetProperties(properties As Map)
Else Else
keepAlive = DEFAULT_KEEP_ALIVE_TIME keepAlive = DEFAULT_KEEP_ALIVE_TIME
poolJO.RunMethod("setKeepaliveTime", Array As Object(keepAlive)) poolJO.RunMethod("setKeepaliveTime", Array As Object(keepAlive))
Log($"Ponemos (LONG, Default): KeepaliveTime, ${DEFAULT_KEEP_ALIVE_TIME} (50 minutos)"$) Log($"Ponemos KeepaliveTime: ${DEFAULT_KEEP_ALIVE_TIME} (50 minutes)"$)
End If End If
processedKeys.Add("keepalivetime") processedKeys.Add("keepalivetime")
KeepAliveTimeConfig = keepAlive ' <-- ALMACENAMIENTO CRÍTICO KeepAliveTimeConfig = keepAlive ' Store the config value
' --- INICIO: PROCESAMIENTO DE PROPIEDADES RESTANTES --- ' Process remaining properties
' ... (El resto del código de procesamiento de propiedades restantes se mantiene igual)
Dim intValue As Int Dim intValue As Int
Dim booleanValue As Boolean Dim booleanValue As Boolean
Dim variableType As String Dim variableType As String
@@ -238,9 +229,9 @@ Public Sub SetProperties(properties As Map)
Else Else
Log($"Connection pool property ${k} has unsupported variable type of ${variableType}"$) Log($"Connection pool property ${k} has unsupported variable type of ${variableType}"$)
End If End If
Log($"Ponemos (Restante): ${k}, ${properties.Get(k)}"$) Log($"Ponemos (Remaining): ${k}, ${properties.Get(k)}"$)
Catch Catch
Log($"Warning (Restante): Method: ${dynamicMethodName} not matched or type mismatch for property ${k}. Error: ${LastException.Message}"$) Log($"Warning (Remaining): Method: ${dynamicMethodName} not matched or type mismatch for property ${k}. Error: ${LastException.Message}"$)
End Try End Try
Else Else
Log($"Warning: Property ${k} not supported"$) Log($"Warning: Property ${k} not supported"$)
@@ -249,23 +240,19 @@ Public Sub SetProperties(properties As Map)
Next Next
End Sub End Sub
' // --------------------------------------------------------------------------------------------------------------------------------------------------- ' Applies specific JDBC Driver properties (e.g., MySQL caching)
' // NUEVA SUBRUTINA: Aplica propiedades específicas del Driver JDBC (Ej: MySQL caching) ' These properties are applied using addDataSourceProperty, which is not supported in standard SetProperties.
' // Estas propiedades se aplican usando addDataSourceProperty, que no se soporta en SetProperties estándar.
' // ---------------------------------------------------------------------------------------------------------------------------------------------------
Public Sub SetDriverProperties(properties As Map) Public Sub SetDriverProperties(properties As Map)
' properties es el mapa que RDCConnector.LoadDriverProperties extrae (ej: driver.mysql.*). ' properties is the map extracted by RDCConnector.LoadDriverProperties (e.g., driver.mysql.*).
Dim value As Object Dim value As Object
For Each k As String In properties.Keys For Each k As String In properties.Keys
value = properties.Get(k) value = properties.Get(k)
' CRÍTICO: Usar addDataSourceProperty para configurar el Driver, no el Pool. ' Use addDataSourceProperty to configure the Driver, not the Pool.
poolJO.RunMethod("addDataSourceProperty", Array As Object(k, value)) poolJO.RunMethod("addDataSourceProperty", Array As Object(k, value))
Log($"HikariCP: Driver Property [${k}] added with value: ${value}"$) Log($"HikariCP: Driver Property [${k}] added with value: ${value}"$)
Next Next
End Sub End Sub
'Check if JDBC URL is supported 'Check if JDBC URL is supported
Public Sub SupportUrl(jdbcUrl As String) As Boolean Public Sub SupportUrl(jdbcUrl As String) As Boolean
If jdbcUrl.StartsWith("jdbc:sqlite") Then If jdbcUrl.StartsWith("jdbc:sqlite") Then
@@ -300,48 +287,47 @@ Public Sub ClosePool
End If End If
End Sub End Sub
' WARNING: This subroutine translates internal HikariCP method names
' ** ADVERTENCIA: Esta subrutina traduce los nombres de métodos internos de HikariCP ' to the generic keys (e.g., BusyConnections) that RDCConnector expects.
' ** a las claves genéricas (ej. BusyConnections) que RDCConnector espera. ' It now includes the STATIC CONFIGURATION saved in the class variables.
' ** CRÍTICO: Ahora incluye la CONFIGURACIÓN ESTÁTICA guardada en las variables de clase.
Public Sub GetStats As Map Public Sub GetStats As Map
Dim stats As Map Dim stats As Map
stats.Initialize stats.Initialize
' 1. AGREGAR PROPIEDADES ESTÁTICAS (CONFIGURACIÓN ALMACENADA) ' 1. ADD STATIC PROPERTIES (STORED CONFIGURATION)
stats.Put("MaxPoolSize", PoolSizeConfig) stats.Put("MaxPoolSize", PoolSizeConfig)
stats.Put("MinPoolSize", MinIdleConfig) stats.Put("MinPoolSize", MinIdleConfig)
stats.Put("MaxLifetime", MaxLifeConfig) stats.Put("MaxLifetime", MaxLifeConfig)
stats.Put("ConnectionTimeout", ConnTimeoutConfig) stats.Put("ConnectionTimeout", ConnTimeoutConfig)
stats.Put("LeakDetectionThreshold", LeakDetectionThresholdConfig) stats.Put("LeakDetectionThreshold", LeakDetectionThresholdConfig)
stats.Put("KeepaliveTime", KeepAliveTimeConfig) stats.Put("KeepaliveTime", KeepAliveTimeConfig)
' Nota: Aquí puedes agregar las propiedades estáticas adicionales que sean relevantes. ' Note: You can add other relevant static properties here.
' 2. OBTENER MÉTRICAS DE TIEMPO DE EJECUCIÓN (JMX/MBean) ' 2. GET RUNTIME METRICS (JMX/MBean)
If poolJO.IsInitialized Then If poolJO.IsInitialized Then
Try Try
Dim poolMBean As JavaObject = poolJO.RunMethod("getHikariPoolMXBean", Null) Dim poolMBean As JavaObject = poolJO.RunMethod("getHikariPoolMXBean", Null)
Dim busyConn As Object = poolMBean.RunMethod("getActiveConnections", Null) Dim busyConn As Object = poolMBean.RunMethod("getActiveConnections", Null)
stats.Put("BusyConnections", busyConn) stats.Put("BusyConnections", busyConn)
Dim idleConn As Object = poolMBean.RunMethod("getIdleConnections", Null) Dim idleConn As Object = poolMBean.RunMethod("getIdleConnections", Null)
stats.Put("IdleConnections", idleConn) stats.Put("IdleConnections", idleConn)
Dim activeCount As Int = busyConn Dim activeCount As Int = busyConn
Dim idleCount As Int = idleConn Dim idleCount As Int = idleConn
stats.Put("TotalConnections", activeCount + idleCount) stats.Put("TotalConnections", activeCount + idleCount)
Dim awaitingConn As Object = poolMBean.RunMethod("getThreadsAwaitingConnection", Null) Dim awaitingConn As Object = poolMBean.RunMethod("getThreadsAwaitingConnection", Null)
stats.Put("ThreadsAwaitingConnection", awaitingConn) stats.Put("ThreadsAwaitingConnection", awaitingConn)
Catch Catch
Dim ErrorMsg As String = "HikariCP.GetStats: Error al obtener métricas dinámicas del MBean: " & LastException.Message Dim ErrorMsg As String = "HikariCP.GetStats: Error getting dynamic metrics from MBean: " & LastException.Message
Log(ErrorMsg) Log(ErrorMsg)
stats.Put("Error_Runtime", ErrorMsg) stats.Put("Error_Runtime", ErrorMsg)
End Try End Try
Else Else
stats.Put("Error", "Pool JO no inicializado") stats.Put("Error", "Pool JO not initialized")
End If End If
Return stats Return stats
End Sub End Sub

492
Manager.bas
View File

@@ -4,34 +4,30 @@ ModulesStructureVersion=1
Type=Class Type=Class
Version=10.3 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
' Módulo de clase: Manager ' Class module: Manager
' Este handler proporciona un panel de administración web para el servidor jRDC2-Multi. ' This handler provides a web administration panel for the jRDC2-Multi server.
' Permite monitorear el estado del servidor, recargar configuraciones de bases de datos, ' It allows monitoring server status, reloading database configurations,
' ver estadísticas de rendimiento, reiniciar servicios externos, y gestionar la autenticación de usuarios. ' viewing performance statistics, restarting external services, and managing user authentication.
Sub Class_Globals Sub Class_Globals
' Objeto para generar respuestas JSON. Se utiliza para mostrar mapas de datos de forma legible. ' Object to generate JSON responses. Used to display data maps legibly.
Dim j As JSONGenerator Dim j As JSONGenerator
' La clase BCrypt no se usa directamente en este módulo, pero se mantiene si hubiera planes futuros. ' The BCrypt class is not used directly in this module, but is kept for any future plans.
' Private bc As BCrypt ' Private bc As BCrypt
End Sub End Sub
' Subrutina de inicialización de la clase. Se llama cuando se crea un objeto de esta clase. ' Class initialization subroutine. Called when an object of this class is created.
Public Sub Initialize Public Sub Initialize
' No se requiere inicialización específica para esta clase en este momento. ' No specific initialization is required for this class at this time.
End Sub End Sub
' Método principal que maneja las peticiones HTTP para el panel de administración. ' Main method that handles HTTP requests for the administration panel.
' req: El objeto ServletRequest que contiene la información de la petición entrante. ' req: The ServletRequest object containing incoming request information.
' resp: El objeto ServletResponse para construir y enviar la respuesta al cliente. ' resp: The ServletResponse object for building and sending the response to the client.
' Módulo de clase: Manager ' Refactored to work as an API with a static frontend.
' ... (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) Sub Handle(req As ServletRequest, resp As ServletResponse)
' --- 1. Bloque de Seguridad --- ' Security Block
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then
resp.SendRedirect("/login") resp.SendRedirect("/login")
Return Return
@@ -39,7 +35,7 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
Dim Command As String = req.GetParameter("command") Dim Command As String = req.GetParameter("command")
' --- 2. Servidor de la Página Principal --- ' Main Page Server
If Command = "" Then If Command = "" Then
Try Try
resp.ContentType = "text/html; charset=utf-8" resp.ContentType = "text/html; charset=utf-8"
@@ -50,10 +46,10 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
Return Return
End If End If
' --- 3. Manejo de Comandos como API --- ' API Command Handling
Select Command.ToLowerCase Select Command.ToLowerCase
' --- Comandos que devuelven JSON (Métricas del Pool) --- ' Commands that return JSON (Pool Metrics)
Case "getstatsold" Case "getstatsold"
resp.ContentType = "application/json; charset=utf-8" resp.ContentType = "application/json; charset=utf-8"
Dim allPoolStats As Map Dim allPoolStats As Map
@@ -63,49 +59,107 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
If connector.IsInitialized Then If connector.IsInitialized Then
allPoolStats.Put(dbKey, connector.GetPoolStats) allPoolStats.Put(dbKey, connector.GetPoolStats)
Else Else
allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado")) allPoolStats.Put(dbKey, CreateMap("Error": "Connector not initialized"))
End If End If
Next Next
j.Initialize(allPoolStats) j.Initialize(allPoolStats)
resp.Write(j.ToString) resp.Write(j.ToString)
Return Return
Case "getstats" Case "getstats"
resp.ContentType = "application/json; charset=utf-8" resp.ContentType = "application/json; charset=utf-8"
Dim allPoolStats As Map Dim allPoolStats As Map
' Leemos del caché global actualizado por el Timer SSE ' We read from the global cache updated by the SSE Timer
allPoolStats = Main.LatestPoolStats allPoolStats = Main.LatestPoolStats
For Each dbKey As String In Main.listaDeCP For Each dbKey As String In Main.listaDeCP
If allPoolStats.ContainsKey(dbKey) = False Then If allPoolStats.ContainsKey(dbKey) = False Then
allPoolStats.Put(dbKey, CreateMap("Error": "Métricas no disponibles/Pool no inicializado")) allPoolStats.Put(dbKey, CreateMap("Error": "Metrics unavailable/Pool not initialized"))
End If End If
Next Next
j.Initialize(allPoolStats) j.Initialize(allPoolStats)
resp.Write(j.ToString) resp.Write(j.ToString)
Return Return
Case "slowqueries" Case "slowqueries"
resp.ContentType = "application/json; charset=utf-8" resp.ContentType = "application/json; charset=utf-8"
Dim results As List Dim results As List
results.Initialize results.Initialize
Try Try
' Verifica la existencia de la tabla de logs antes de consultar ' --- 1. VALIDACIÓN Y PARSEO DEFENSIVO DE PARÁMETROS ---
Dim tableExists As Boolean = Main.SQL1.ExecQuerySingleResult($"SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs';"$) <> Null
' Capturamos los parámetros numéricos como Strings primero para chequear si están vacíos.
Dim limitStr As String = req.GetParameter("limit")
Dim minutesStr As String = req.GetParameter("minutes")
Dim limit As Int = 0
Dim minutes As Int = 0
' 1a. Parseo seguro de 'limit'. Evita NumberFormatException si el string es "" o Null.
If limitStr <> Null And limitStr.Trim.Length > 0 Then
limit = limitStr.As(Int)
End If
' 1b. Parseo seguro de 'minutes'.
If minutesStr <> Null And minutesStr.Trim.Length > 0 Then
minutes = minutesStr.As(Int)
End If
' Parámetros de ordenamiento (ya son strings, no necesitan chequeo de NFE)
Dim sortby As String = req.GetParameter("sortby").ToLowerCase.Trim ' Columna para ordenar (Default: duration_ms)
Dim sortorder As String = req.GetParameter("sortorder").ToUpperCase.Trim ' Orden (Default: DESC)
' Establecer Defaults (ahora esta lógica funciona porque limit y minutes son 0 si el parámetro estaba vacío o ausente)
If limit = 0 Then limit = 20 ' Límite de registros (Default: 20)
If minutes = 0 Then minutes = 60 ' Filtro de tiempo en minutos (Default: 60 - última hora)
' --- Lista Blanca (Whitelist) para prevención de Inyección SQL en ORDER BY ---
Dim allowedSortColumns As List
allowedSortColumns.Initialize
allowedSortColumns.AddAll(Array As Object("duration_ms", "timestamp", "db_key", "client_ip", "busy_connections", "handler_active_requests", "query_name"))
If allowedSortColumns.IndexOf(sortby) = -1 Then
sortby = "duration_ms" ' Usar default seguro si no se encuentra
End If
If sortorder <> "ASC" And sortorder <> "DESC" Then
sortorder = "DESC"
End If
' --- 2. PREPARACIÓN DE LA CONSULTA SQL ---
' We use SQL_Logs instance to check for the table existence.
Dim tableExists As Boolean = Main.SQL_Logs.ExecQuerySingleResult($"SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs'"$) <> Null
If tableExists = False Then If tableExists = False Then
j.Initialize(CreateMap("message": "La tabla de logs ('query_logs') no existe. Habilita 'enableSQLiteLogs=1' en la configuración.")) j.Initialize(CreateMap("message": "La tabla de logs ('query_logs') no existe. Habilite 'enableSQLiteLogs=1' en la configuración."))
resp.Write(j.ToString) resp.Write(j.ToString)
Return Return
End If End If
' Consulta las 20 queries más lentas de la última hora ' Calcular el tiempo de corte (flexible)
Dim oneHourAgoMs As Long = DateTime.Now - 3600000 Dim cutOffTimeMs As Long = DateTime.Now - (minutes * 60000)
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"$)
Dim sqlQuery As String = $"
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 >= ${cutOffTimeMs}
ORDER BY ${sortby} ${sortorder}
LIMIT ${limit}"$
Dim rs As ResultSet = Main.SQL_Logs.ExecQuery(sqlQuery) ' --- Execute query on SQL_Logs instance
Do While rs.NextRow Do While rs.NextRow
Dim row As Map Dim row As Map
row.Initialize row.Initialize
@@ -118,33 +172,39 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
row.Put("Peticiones_Activas", rs.GetInt("handler_active_requests")) row.Put("Peticiones_Activas", rs.GetInt("handler_active_requests"))
results.Add(row) results.Add(row)
Loop Loop
rs.Close rs.Close
Dim root As Map Dim root As Map
root.Initialize root.Initialize
root.Put("data", results) root.Put("data", results)
' Añadir meta información para diagnóstico
Dim meta As Map = CreateMap("limit_applied": limit, "sorted_by": sortby, "sort_order": sortorder, "minutes_filter": minutes)
root.Put("meta", meta)
j.Initialize(root) j.Initialize(root)
resp.Write(j.ToString) resp.Write(j.ToString)
Catch Catch
Log("Error CRÍTICO al obtener queries lentas en Manager API: " & LastException.Message) Log("CRITICAL Error getting slow queries in Manager API: " & LastException.Message)
resp.Status = 500 resp.Status = 500
Dim root As Map Dim root As Map
root.Initialize root.Initialize
root.Put("data", results) root.Put("data", results)
j.Initialize(root) j.Initialize(CreateMap("message": "Error interno al procesar logs. Detalle: " & LastException.Message))
resp.Write(j.ToString) resp.Write(j.ToString)
End Try End Try
Return Return
Case "logs", "totalrequests", "totalblocked" Case "logs", "totalrequests", "totalblocked"
resp.ContentType = "application/json; charset=utf-8" resp.ContentType = "application/json; charset=utf-8"
Dim mp As Map Dim mp As Map
If Command = "logs" And GlobalParameters.mpLogs.IsInitialized Then mp = GlobalParameters.mpLogs If Command = "logs" And GlobalParameters.mpLogs.IsInitialized Then mp = GlobalParameters.mpLogs
If Command = "totalrequests" And GlobalParameters.mpTotalRequests.IsInitialized Then mp = GlobalParameters.mpTotalRequests If Command = "totalrequests" And GlobalParameters.mpTotalRequests.IsInitialized Then mp = GlobalParameters.mpTotalRequests
If Command = "totalblocked" And GlobalParameters.mpBlockConnection.IsInitialized Then mp = GlobalParameters.mpBlockConnection If Command = "totalblocked" And GlobalParameters.mpBlockConnection.IsInitialized Then mp = GlobalParameters.mpBlockConnection
If mp.IsInitialized Then If mp.IsInitialized Then
j.Initialize(mp) j.Initialize(mp)
resp.Write(j.ToString) resp.Write(j.ToString)
@@ -152,108 +212,107 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
resp.Write("{}") resp.Write("{}")
End If End If
Return Return
' --- Comandos que devuelven TEXTO PLANO --- ' Commands that return PLAIN TEXT
Case "ping" Case "ping"
resp.ContentType = "text/plain" resp.ContentType = "text/plain"
resp.Write($"Pong ($DateTime{DateTime.Now})"$) resp.Write($"Pong ($DateTime{DateTime.Now})"$)
Return Return
Case "reload" Case "reload"
resp.ContentType = "text/plain; charset=utf-8" resp.ContentType = "text/plain; charset=utf-8"
Dim sbTemp As StringBuilder Dim sbTemp As StringBuilder
sbTemp.Initialize sbTemp.Initialize
' ***** LÓGICA DE RECARGA GRANULAR/SELECTIVA ***** Dim dbKeyToReload As String = req.GetParameter("db").ToUpperCase ' Read optional 'db' parameter (e.g., /manager?command=reload&db=DB3)
Dim dbKeyToReload As String = req.GetParameter("db").ToUpperCase ' Leer parámetro 'db' opcional (ej: /manager?command=reload&db=DB3) Dim targets As List ' List of DBKeys to reload.
Dim targets As List ' Lista de DBKeys a recargar.
targets.Initialize targets.Initialize
' 1. Determinar el alcance de la recarga (selectiva o total) ' 1. Determine the scope of the reload (selective or total)
If dbKeyToReload.Length > 0 Then If dbKeyToReload.Length > 0 Then
' Recarga selectiva ' Selective reload
If Main.listaDeCP.IndexOf(dbKeyToReload) = -1 Then If Main.listaDeCP.IndexOf(dbKeyToReload) = -1 Then
resp.Write($"ERROR: DBKey '${dbKeyToReload}' no es válida o no está configurada."$) resp.Write($"ERROR: DBKey '${dbKeyToReload}' is not valid or not configured."$)
Return Return
End If End If
targets.Add(dbKeyToReload) targets.Add(dbKeyToReload)
sbTemp.Append($"Iniciando recarga selectiva de ${dbKeyToReload} (Hot-Swap)..."$).Append(" " & CRLF) sbTemp.Append($"Starting selective reload of ${dbKeyToReload} (Hot-Swap)..."$).Append(" " & CRLF)
Else Else
' Recarga completa (comportamiento por defecto) ' Full reload (default behavior)
targets.AddAll(Main.listaDeCP) targets.AddAll(Main.listaDeCP)
sbTemp.Append($"Iniciando recarga COMPLETA de configuración (Hot-Swap) ($DateTime{DateTime.Now})"$).Append(" " & CRLF) sbTemp.Append($"Starting COMPLETE configuration reload (Hot-Swap) ($DateTime{DateTime.Now})"$).Append(" " & CRLF)
End If End If
' 2. Deshabilitar el Timer de logs (si es necesario) ' 2. Disable the log Timer (if necessary)
Dim oldTimerState As Boolean = Main.timerLogs.Enabled Dim oldTimerState As Boolean = Main.timerLogs.Enabled
If oldTimerState Then If oldTimerState Then
Main.timerLogs.Enabled = False Main.timerLogs.Enabled = False
sbTemp.Append(" -> Timer de limpieza de logs (SQLite) detenido temporalmente.").Append(" " & CRLF) sbTemp.Append(" -> Log cleanup timer (SQLite) stopped temporarily.").Append(" " & CRLF)
End If End If
Dim reloadSuccessful As Boolean = True Dim reloadSuccessful As Boolean = True
Dim oldConnectorsToClose As Map ' Guardaremos los conectores antiguos aquí. Dim oldConnectorsToClose As Map ' We will store the old connectors here.
oldConnectorsToClose.Initialize oldConnectorsToClose.Initialize
' 3. Procesar solo los conectores objetivos ' 3. Process only the target connectors
For Each dbKey As String In targets For Each dbKey As String In targets
sbTemp.Append($" -> Procesando recarga de ${dbKey}..."$).Append(CRLF) sbTemp.Append($" -> Processing reload of ${dbKey}..."$).Append(CRLF)
Dim newRDC As RDCConnector Dim newRDC As RDCConnector
Try Try
' Crear el nuevo conector con la configuración fresca ' Create the new connector with the fresh configuration
newRDC.Initialize(dbKey) newRDC.Initialize(dbKey)
' Adquirimos el lock para el reemplazo atómico ' Acquire the lock for atomic replacement
Main.MainConnectorsLock.RunMethod("lock", Null) Main.MainConnectorsLock.RunMethod("lock", Null)
' Guardamos el conector antiguo (si existe) ' Save the old connector (if it exists)
Dim oldRDC As RDCConnector = Main.Connectors.Get(dbKey) Dim oldRDC As RDCConnector = Main.Connectors.Get(dbKey)
' Reemplazo atómico en el mapa global compartido ' Atomic replacement in the shared global map
Main.Connectors.Put(dbKey, newRDC) Main.Connectors.Put(dbKey, newRDC)
' Liberamos el bloqueo inmediatamente ' Release the lock immediately
Main.MainConnectorsLock.RunMethod("unlock", Null) Main.MainConnectorsLock.RunMethod("unlock", Null)
' Si había un conector antiguo, lo guardamos para cerrarlo después ' If there was an old connector, save it to close later
If oldRDC.IsInitialized Then If oldRDC.IsInitialized Then
oldConnectorsToClose.Put(dbKey, oldRDC) oldConnectorsToClose.Put(dbKey, oldRDC)
End If End If
' 4. Actualizar el estado de logs (Granular) ' 4. Update log status (Granular)
Dim enableLogsSetting As Int = newRDC.config.GetDefault("enableSQLiteLogs", 0) Dim enableLogsSetting As Int = newRDC.config.GetDefault("enableSQLiteLogs", 0)
Dim isEnabled As Boolean = (enableLogsSetting = 1) Dim isEnabled As Boolean = (enableLogsSetting = 1)
Main.SQLiteLoggingStatusByDB.Put(dbKey, isEnabled) Main.SQLiteLoggingStatusByDB.Put(dbKey, isEnabled)
sbTemp.Append($" -> ${dbKey} recargado. Logs (config): ${isEnabled}"$).Append(CRLF) sbTemp.Append($" -> ${dbKey} reloaded. Logs (config): ${isEnabled}"$).Append(CRLF)
Catch Catch
' Si falla la inicialización del pool, no actualizamos Main.Connectors ' If pool initialization fails, we don't update Main.Connectors
' ¡CRÍTICO! Aseguramos que el lock se libere si hubo excepción antes de liberar. ' Ensure the lock is released if an exception occurred before release.
If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then
Main.MainConnectorsLock.RunMethod("unlock", Null) Main.MainConnectorsLock.RunMethod("unlock", Null)
End If End If
sbTemp.Append($" -> ERROR CRÍTICO al inicializar conector para ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF) sbTemp.Append($" -> CRITICAL ERROR initializing connector for ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF)
reloadSuccessful = False reloadSuccessful = False
Exit Exit
End Try End Try
Next Next
' 5. Cerrar los pools antiguos liberados (FUERA del Lock) ' 5. Close the old released pools (OUTSIDE the Lock)
If reloadSuccessful Then If reloadSuccessful Then
For Each dbKey As String In oldConnectorsToClose.Keys For Each dbKey As String In oldConnectorsToClose.Keys
Dim oldRDC As RDCConnector = oldConnectorsToClose.Get(dbKey) Dim oldRDC As RDCConnector = oldConnectorsToClose.Get(dbKey)
oldRDC.Close ' Cierre limpio del pool C3P0 oldRDC.Close ' Clean closure of the C3P0 pool
sbTemp.Append($" -> Pool antiguo de ${dbKey} cerrado limpiamente."$).Append(" " & CRLF) sbTemp.Append($" -> Old pool for ${dbKey} closed cleanly."$).Append(" " & CRLF)
Next Next
' 6. Re-evaluar el estado global de Logs (CRÍTICO: debe revisar TODAS las DBs) ' 6. Re-evaluate the global Log status (must check ALL DBs)
Main.IsAnySQLiteLoggingEnabled = False Main.IsAnySQLiteLoggingEnabled = False
For Each dbKey As String In Main.listaDeCP For Each dbKey As String In Main.listaDeCP
' Revisamos el estado de log de CADA conector activo ' We check the log status of EACH active connector
If Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False) Then If Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False) Then
Main.IsAnySQLiteLoggingEnabled = True Main.IsAnySQLiteLoggingEnabled = True
Exit Exit
@@ -261,19 +320,19 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
Next Next
If Main.IsAnySQLiteLoggingEnabled Then If Main.IsAnySQLiteLoggingEnabled Then
Main.timerLogs.Enabled = True Main.timerLogs.Enabled = True
sbTemp.Append($" -> Timer de limpieza de logs ACTIVADO (estado global: HABILITADO)."$).Append(" " & CRLF) sbTemp.Append($" -> Log cleanup timer ACTIVATED (global status: ENABLED)."$).Append(" " & CRLF)
Else Else
Main.timerLogs.Enabled = False Main.timerLogs.Enabled = False
sbTemp.Append($" -> Timer de limpieza de logs DESHABILITADO (estado global: DESHABILITADO)."$).Append(" " & CRLF) sbTemp.Append($" -> Log cleanup timer DISABLED (global status: DISABLED)."$).Append(" " & CRLF)
End If End If
sbTemp.Append($"¡Recarga de configuración completada con éxito!"$).Append(" " & CRLF) sbTemp.Append($"Configuration reload completed successfully!"$).Append(" " & CRLF)
Else Else
' Si falló, restauramos el estado del timer anterior. ' If it failed, restore the previous timer state.
If oldTimerState Then If oldTimerState Then
Main.timerLogs.Enabled = True Main.timerLogs.Enabled = True
sbTemp.Append(" -> Restaurando Timer de limpieza de logs al estado ACTIVO debido a fallo en recarga.").Append(" " & CRLF) sbTemp.Append(" -> Restoring Log cleanup timer to ACTIVE state due to reload failure.").Append(" " & CRLF)
End If End If
sbTemp.Append($"¡ERROR: La recarga de configuración falló! Los conectores antiguos siguen activos."$).Append(" " & CRLF) sbTemp.Append($"ERROR: Configuration reload failed! Old connectors are still active."$).Append(" " & CRLF)
End If End If
resp.Write(sbTemp.ToString) resp.Write(sbTemp.ToString)
Return Return
@@ -281,57 +340,57 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
resp.ContentType = "text/plain; charset=utf-8" resp.ContentType = "text/plain; charset=utf-8"
Dim sb As StringBuilder Dim sb As StringBuilder
sb.Initialize sb.Initialize
sb.Append("--- INICIANDO PRUEBA DE CONECTIVIDAD A TODOS LOS POOLS CONFIGURADOS ---").Append(CRLF).Append(CRLF) sb.Append("--- STARTING CONNECTIVITY TEST TO ALL CONFIGURED POOLS ---").Append(CRLF).Append(CRLF)
' Iteramos sobre la lista de DB Keys cargadas al inicio (DB1, DB2, etc.) ' We iterate over the list of DB Keys loaded at startup (DB1, DB2, etc.)
For Each dbKey As String In Main.listaDeCP For Each dbKey As String In Main.listaDeCP
Dim success As Boolean = False Dim success As Boolean = False
Dim errorMsg As String = "" Dim errorMsg As String = ""
Dim con As SQL ' Conexión para la prueba Dim con As SQL ' Connection for the test
Try Try
' 1. Obtener el RDCConnector para esta DBKey ' 1. Get the RDCConnector for this DBKey
Dim connector As RDCConnector = Main.Connectors.Get(dbKey) Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
If connector.IsInitialized = False Then If connector.IsInitialized = False Then
errorMsg = "Conector no inicializado (revisa logs de AppStart)" errorMsg = "Connector not initialized (check AppStart logs)"
Else Else
' 2. Forzar la adquisición de una conexión del pool C3P0 ' 2. Force acquisition of a connection from the C3P0 pool
con = connector.GetConnection(dbKey) con = connector.GetConnection(dbKey)
If con.IsInitialized Then If con.IsInitialized Then
' 3. Si la conexión es válida, la cerramos inmediatamente para devolverla al pool ' 3. If the connection is valid, close it immediately to return it to the pool
con.Close con.Close
success = True success = True
Else Else
errorMsg = "La conexión devuelta no es válida (SQL.IsInitialized = False)" errorMsg = "Returned connection is not valid (SQL.IsInitialized = False)"
End If End If
End If End If
Catch Catch
' Capturamos cualquier excepción (ej. fallo de JDBC, timeout de C3P0) ' We catch any exception (e.g., JDBC failure, C3P0 timeout)
errorMsg = LastException.Message errorMsg = LastException.Message
End Try End Try
If success Then If success Then
sb.Append($"* ${dbKey}: Conexión adquirida y liberada correctamente."$).Append(CRLF) sb.Append($"* ${dbKey}: Connection acquired and released successfully."$).Append(CRLF)
Else Else
' Si falla, registramos el error para el administrador. ' If it fails, log the error for the administrator.
Main.LogServerError("ERROR", "Manager.TestCommand", $"Falló la prueba de conectividad para ${dbKey}: ${errorMsg}"$, dbKey, "test_command", req.RemoteAddress) Main.LogServerError("ERROR", "Manager.TestCommand", $"Connectivity test failed for ${dbKey}: ${errorMsg}"$, dbKey, "test_command", req.RemoteAddress)
sb.Append($"[FALLO] ${dbKey}: ERROR CRÍTICO al obtener conexión. Mensaje: ${errorMsg}"$).Append(CRLF) sb.Append($"[FAILED] ${dbKey}: CRITICAL ERROR getting connection. Message: ${errorMsg}"$).Append(CRLF)
End If End If
Next Next
sb.Append(CRLF).Append("--- FIN DE PRUEBA DE CONEXIONES ---").Append(CRLF) sb.Append(CRLF).Append("--- END OF CONNECTION TEST ---").Append(CRLF)
' Mantenemos la lista original de archivos de configuración cargados (esto es informativo) ' We keep the original list of loaded config files (this is informational)
sb.Append(CRLF).Append("Archivos de configuración cargados:").Append(CRLF) sb.Append(CRLF).Append("Loaded configuration files:").Append(CRLF)
For Each item As String In Main.listaDeCP For Each item As String In Main.listaDeCP
Dim configName As String = "config" Dim configName As String = "config"
If item <> "DB1" Then configName = configName & "." & item If item <> "DB1" Then configName = configName & "." & item
sb.Append($" -> Usando ${configName}.properties"$).Append(CRLF) sb.Append($" -> Using ${configName}.properties"$).Append(CRLF)
Next Next
resp.Write(sb.ToString) resp.Write(sb.ToString)
Return Return
Case "rsx", "rpm2", "revivebow", "restartserver" Case "rsx", "rpm2", "revivebow", "restartserver"
@@ -341,161 +400,154 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
Case "rsx": batFile = "start.bat" Case "rsx": batFile = "start.bat"
Case "rpm2": batFile = "reiniciaProcesoPM2.bat" Case "rpm2": batFile = "reiniciaProcesoPM2.bat"
Case "reviveBow": batFile = "reiniciaProcesoBow.bat" Case "reviveBow": batFile = "reiniciaProcesoBow.bat"
Case "restartserver": batFile = "restarServer.bat" ' Nota: este bat no estaba definido, se usó el nombre del comando Case "restartserver": batFile = "restarServer.bat" ' Note: this bat was not defined, command name was used
End Select End Select
Log($"Ejecutando ${File.DirApp}\${batFile}"$) Log($"Executing ${File.DirApp}\${batFile}"$)
Try Try
Dim shl As Shell Dim shl As Shell
shl.Initialize("shl","cmd", Array("/c", File.DirApp & "\" & batFile & " " & Main.srvr.Port)) shl.Initialize("shl","cmd", Array("/c", File.DirApp & "\" & batFile & " " & Main.srvr.Port))
shl.WorkingDirectory = File.DirApp shl.WorkingDirectory = File.DirApp
shl.Run(-1) shl.Run(-1)
resp.Write($"Comando '${Command}' ejecutado. Script invocado: ${batFile}"$) resp.Write($"Command '${Command}' executed. Script invoked: ${batFile}"$)
Catch Catch
resp.Write($"Error al ejecutar el script para '${Command}': ${LastException.Message}"$) resp.Write($"Error executing script for '${Command}': ${LastException.Message}"$)
End Try End Try
Return Return
Case "paused", "continue" Case "paused", "continue"
resp.ContentType = "text/plain; charset=utf-8" resp.ContentType = "text/plain; charset=utf-ab"
If Command = "paused" Then If Command = "paused" Then
GlobalParameters.IsPaused = 1 GlobalParameters.IsPaused = 1
resp.Write("Servidor pausado.") resp.Write("Server paused.")
Else Else
GlobalParameters.IsPaused = 0 GlobalParameters.IsPaused = 0
resp.Write("Servidor reanudado.") resp.Write("Server resumed.")
End If End If
Return Return
Case "block", "unblock" Case "block", "unblock"
resp.ContentType = "text/plain; charset=utf-8" resp.ContentType = "text/plain; charset=utf-8"
Dim ip As String = req.GetParameter("IP") Dim ip As String = req.GetParameter("IP")
If ip = "" Then If ip = "" Then
resp.Write("Error: El parámetro IP es requerido.") resp.Write("Error: The IP parameter is required.")
Return Return
End If End If
If GlobalParameters.mpBlockConnection.IsInitialized Then If GlobalParameters.mpBlockConnection.IsInitialized Then
If Command = "block" Then If Command = "block" Then
GlobalParameters.mpBlockConnection.Put(ip, ip) GlobalParameters.mpBlockConnection.Put(ip, ip)
resp.Write($"IP bloqueada: ${ip}"$) resp.Write($"IP blocked: ${ip}"$)
Else Else
GlobalParameters.mpBlockConnection.Remove(ip) GlobalParameters.mpBlockConnection.Remove(ip)
resp.Write($"IP desbloqueada: ${ip}"$) resp.Write($"IP unblocked: ${ip}"$)
End If End If
Else Else
resp.Write("Error: El mapa de bloqueo no está inicializado.") resp.Write("Error: The block map is not initialized.")
End If End If
Return Return
Case "getconfiginfo" Case "getconfiginfo"
resp.ContentType = "text/plain; charset=utf-8" resp.ContentType = "text/plain; charset=utf-8"
Dim sbInfo As StringBuilder Dim sbInfo As StringBuilder
sbInfo.Initialize sbInfo.Initialize
Dim allKeys As List Dim allKeys As List
allKeys.Initialize allKeys.Initialize
allKeys.AddAll(Main.listaDeCP) allKeys.AddAll(Main.listaDeCP)
sbInfo.Append("======================================================================").Append(CRLF) sbInfo.Append("======================================================================").Append(CRLF)
sbInfo.Append($"=== CONFIGURACIÓN jRDC2-Multi V$1.2{Main.VERSION} (ACTIVA) ($DateTime{DateTime.Now}) ==="$).Append(CRLF) sbInfo.Append($"=== jRDC2-Multi V$1.2{Main.VERSION} CONFIGURATION (ACTIVE) ($DateTime{DateTime.Now}) ==="$).Append(CRLF)
sbInfo.Append("======================================================================").Append(CRLF).Append(CRLF) sbInfo.Append("======================================================================").Append(CRLF).Append(CRLF)
' ***** GLOSARIO DE PARÁMETROS CONFIGURABLES ***** sbInfo.Append("### GLOSSARY OF ALLOWED PARAMETERS IN CONFIG.PROPERTIES (HIKARICP) ###").Append(CRLF)
sbInfo.Append("### GLOSARIO DE PARÁMETROS PERMITIDOS EN CONFIG.PROPERTIES (HIKARICP) ###").Append(CRLF)
sbInfo.Append("--------------------------------------------------").Append(CRLF) sbInfo.Append("--------------------------------------------------").Append(CRLF)
sbInfo.Append("DriverClass: Clase del driver JDBC (ej: oracle.jdbc.driver.OracleDriver).").Append(CRLF) sbInfo.Append("DriverClass: JDBC driver class (e.g., oracle.jdbc.driver.OracleDriver).").Append(CRLF)
sbInfo.Append("JdbcUrl: URL de conexión a la base de datos (IP, puerto, servicio).").Append(CRLF) sbInfo.Append("JdbcUrl: Database connection URL (IP, port, service).").Append(CRLF)
sbInfo.Append("User/Password: Credenciales de acceso a la BD.").Append(CRLF) sbInfo.Append("User/Password: DB access credentials.").Append(CRLF)
sbInfo.Append("ServerPort: Puerto de escucha del servidor B4J (solo lo toma de config.properties).").Append(CRLF) sbInfo.Append("ServerPort: B4J server listening port (only taken from config.properties).").Append(CRLF)
sbInfo.Append("Debug: Si es 'true', los comandos SQL se recargan en cada petición (DESHABILITADO, USAR COMANDO RELOAD).").Append(CRLF) sbInfo.Append("Debug: If 'true', SQL commands are reloaded on each request (DISABLED, USE RELOAD COMMAND).").Append(CRLF)
sbInfo.Append("parameterTolerance: Define si se recortan (1) o se rechazan (0) los parámetros SQL sobrantes a los requeridos por el query.").Append(CRLF) sbInfo.Append("parameterTolerance: Defines whether to trim (1) or reject (0) SQL parameters exceeding those required by the query.").Append(CRLF)
sbInfo.Append("enableSQLiteLogs: Control granular. Habilita (1) o deshabilita (0) la escritura de logs en users.db para esta DB.").Append(CRLF) sbInfo.Append("enableSQLiteLogs: Granular control. Enables (1) or disables (0) writing logs to users.db for this DB.").Append(CRLF)
' --- Parámetros de HIKARICP (Foco en el mínimo set de tuning) --- sbInfo.Append("pool.hikari.maximumPoolSize: Maximum simultaneous connections allowed. (Recommended N*Cores DB),").Append(CRLF)
sbInfo.Append("pool.hikari.maximumPoolSize: Máximo de conexiones simultáneas permitido. (Recomendado N*Cores DB),").Append(CRLF) sbInfo.Append("pool.hikari.minimumIdle: Minimum idle connections. Recommended equal to maximumPoolSize for fixed-size pool,").Append(CRLF)
sbInfo.Append("pool.hikari.minimumIdle: Mínimo de conexiones inactivas. Recomendado igual a maximumPoolSize para pool de tamaño fijo,").Append(CRLF) sbInfo.Append("pool.hikari.maxLifetime (ms): Maximum lifetime of a connection. CRITICAL: Must be less than firewall/DB timeout,").Append(CRLF)
sbInfo.Append("pool.hikari.maxLifetime (ms): Tiempo máximo de vida de una conexión. CRÍTICO: Debe ser menor que el timeout del firewall/DB,").Append(CRLF) sbInfo.Append("pool.hikari.connectionTimeout (ms): Maximum time client waits for an available connection (Default: 30000 ms),").Append(CRLF)
sbInfo.Append("pool.hikari.connectionTimeout (ms): Tiempo máximo de espera del cliente por una conexión disponible (Default: 30000 ms),").Append(CRLF) sbInfo.Append("pool.hikari.idleTimeout (ms): Idle time before retiring the connection (ms). Only applies if minimumIdle < maximumPoolSize,").Append(CRLF)
sbInfo.Append("pool.hikari.idleTimeout (ms): Tiempo inactivo antes de retirar la conexión (ms). Solo aplica si minimumIdle < maximumPoolSize,").Append(CRLF) sbInfo.Append("pool.hikari.leakDetectionThreshold (ms): Threshold (ms) to detect unreturned connections (leaks).").Append(CRLF)
sbInfo.Append("pool.hikari.leakDetectionThreshold (ms): Umbral (ms) para detectar conexiones no devueltas (fugas).").Append(CRLF)
sbInfo.Append(CRLF) sbInfo.Append(CRLF)
For Each dbKey As String In allKeys For Each dbKey As String In allKeys
' --- COMIENZA EL DETALLE POR CONECTOR ---
Dim connector As RDCConnector = Main.Connectors.Get(dbKey) Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
sbInfo.Append("--------------------------------------------------").Append(CRLF).Append(CRLF) sbInfo.Append("--------------------------------------------------").Append(CRLF).Append(CRLF)
sbInfo.Append($"---------------- ${dbKey} ------------------"$).Append(CRLF).Append(CRLF) sbInfo.Append($"---------------- ${dbKey} ------------------"$).Append(CRLF).Append(CRLF)
If connector.IsInitialized Then If connector.IsInitialized Then
Dim configMap As Map = connector.config Dim configMap As Map = connector.config
' Obtener las métricas y la configuración REAL aplicada por HikariCP ' Get metrics and REAL configuration applied by HikariCP
Dim poolStats As Map = connector.GetPoolStats Dim poolStats As Map = connector.GetPoolStats
sbInfo.Append($"DriverClass: ${configMap.GetDefault("DriverClass", "N/A")}"$).Append(CRLF) sbInfo.Append($"DriverClass: ${configMap.GetDefault("DriverClass", "N/A")}"$).Append(CRLF)
sbInfo.Append($"JdbcUrl: ${configMap.GetDefault("JdbcUrl", "N/A")}"$).Append(CRLF) sbInfo.Append($"JdbcUrl: ${configMap.GetDefault("JdbcUrl", "N/A")}"$).Append(CRLF)
sbInfo.Append($"User: ${configMap.GetDefault("User", "N/A")}"$).Append(CRLF) sbInfo.Append($"User: ${configMap.GetDefault("User", "N/A")}"$).Append(CRLF)
sbInfo.Append($"ServerPort: ${configMap.GetDefault("ServerPort", "N/A")}"$).Append(CRLF).Append(CRLF) sbInfo.Append($"ServerPort: ${configMap.GetDefault("ServerPort", "N/A")}"$).Append(CRLF).Append(CRLF)
sbInfo.Append("--- CONFIGURACIÓN DEL POOL (HIKARICP - Valores Aplicados) ---").Append(CRLF) sbInfo.Append("--- POOL CONFIGURATION (HIKARICP - Applied Values) ---").Append(CRLF)
sbInfo.Append($"MaximumPoolSize (Aplicado): ${poolStats.GetDefault("MaxPoolSize", 10).As(Int)}"$).Append(CRLF) sbInfo.Append($"MaximumPoolSize (Applied): ${poolStats.GetDefault("MaxPoolSize", 10).As(Int)}"$).Append(CRLF)
sbInfo.Append($"MinimumIdle (Aplicado): ${poolStats.GetDefault("MinPoolSize", 10).As(Int)}"$).Append(CRLF) sbInfo.Append($"MinimumIdle (Applied): ${poolStats.GetDefault("MinPoolSize", 10).As(Int)}"$).Append(CRLF)
' Reportamos los timeouts en Milisegundos (ms) ' Report timeouts in Milliseconds (ms)
sbInfo.Append($"MaxLifetime (ms): ${poolStats.GetDefault("MaxLifetime", 1800000).As(Long)}"$).Append(CRLF) sbInfo.Append($"MaxLifetime (ms): ${poolStats.GetDefault("MaxLifetime", 1800000).As(Long)}"$).Append(CRLF)
sbInfo.Append($"ConnectionTimeout (ms): ${poolStats.GetDefault("ConnectionTimeout", 30000).As(Long)}"$).Append(CRLF) sbInfo.Append($"ConnectionTimeout (ms): ${poolStats.GetDefault("ConnectionTimeout", 30000).As(Long)}"$).Append(CRLF)
sbInfo.Append($"IdleTimeout (ms): ${poolStats.GetDefault("IdleTimeout", 600000).As(Long)}"$).Append(CRLF) sbInfo.Append($"IdleTimeout (ms): ${poolStats.GetDefault("IdleTimeout", 600000).As(Long)}"$).Append(CRLF)
sbInfo.Append($"LeakDetectionThreshold (ms): ${poolStats.GetDefault("LeakDetectionThreshold", 0).As(Long)}"$).Append(CRLF).Append(CRLF) sbInfo.Append($"LeakDetectionThreshold (ms): ${poolStats.GetDefault("LeakDetectionThreshold", 0).As(Long)}"$).Append(CRLF).Append(CRLF)
' *** NUEVA SECCIÓN: PROPIEDADES ESPECÍFICAS DEL DRIVER ***
If connector.driverProperties.IsInitialized And connector.driverProperties.Size > 0 Then If connector.driverProperties.IsInitialized And connector.driverProperties.Size > 0 Then
sbInfo.Append("--- PROPIEDADES DE RENDIMIENTO DEL DRIVER JDBC (Optimización de Sentencias) ---").Append(CRLF) sbInfo.Append("--- JDBC DRIVER PERFORMANCE PROPERTIES (Statement Optimization) ---").Append(CRLF)
For Each propKey As String In connector.driverProperties.Keys For Each propKey As String In connector.driverProperties.Keys
Dim propValue As Object = connector.driverProperties.Get(propKey) Dim propValue As Object = connector.driverProperties.Get(propKey)
sbInfo.Append($"[Driver] ${propKey}: ${propValue}"$).Append(CRLF) sbInfo.Append($"[Driver] ${propKey}: ${propValue}"$).Append(CRLF)
Next Next
sbInfo.Append(CRLF) sbInfo.Append(CRLF)
End If End If
' *** FIN DE LA NUEVA SECCIÓN ***
' Reportamos métricas de runtime del pool (si están disponibles). sbInfo.Append("--- RUNTIME STATUS (Dynamic Metrics) ---").Append(CRLF)
sbInfo.Append("--- ESTADO DE RUNTIME (Métricas Dinámicas) ---").Append(CRLF)
sbInfo.Append($"Total Connections: ${poolStats.GetDefault("TotalConnections", "N/A")}"$).Append(CRLF) sbInfo.Append($"Total Connections: ${poolStats.GetDefault("TotalConnections", "N/A")}"$).Append(CRLF)
sbInfo.Append($"Busy Connections: ${poolStats.GetDefault("BusyConnections", "N/A")}"$).Append(CRLF) sbInfo.Append($"Busy Connections: ${poolStats.GetDefault("BusyConnections", "N/A")}"$).Append(CRLF)
sbInfo.Append($"Idle Connections: ${poolStats.GetDefault("IdleConnections", "N/A")}"$).Append(CRLF) sbInfo.Append($"Idle Connections: ${poolStats.GetDefault("IdleConnections", "N/A")}"$).Append(CRLF)
sbInfo.Append($"Handler Active Requests: ${poolStats.GetDefault("HandlerActiveRequests", "N/A")}"$).Append(CRLF).Append(CRLF) sbInfo.Append($"Handler Active Requests: ${poolStats.GetDefault("HandlerActiveRequests", "N/A")}"$).Append(CRLF).Append(CRLF)
sbInfo.Append("--- COMPORTAMIENTO ---").Append(CRLF) sbInfo.Append("--- BEHAVIOR ---").Append(CRLF)
sbInfo.Append($"Debug (Recarga Queries - DESHABILITADO): ${configMap.GetDefault("Debug", "false")}"$).Append(CRLF) sbInfo.Append($"Debug (Reload Queries - DISABLED): ${configMap.GetDefault("Debug", "false")}"$).Append(CRLF)
Dim tolerance As Int = configMap.GetDefault("parameterTolerance", 0).As(Int) Dim tolerance As Int = configMap.GetDefault("parameterTolerance", 0).As(Int)
sbInfo.Append($"ParameterTolerance: ${tolerance} (0=Estricto, 1=Habilitado)"$).Append(CRLF) sbInfo.Append($"ParameterTolerance: ${tolerance} (0=Strict, 1=Enabled)"$).Append(CRLF)
Dim isLogsEnabledRuntime As Boolean = Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False).As(Boolean) Dim isLogsEnabledRuntime As Boolean = Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False).As(Boolean)
Dim logsEnabledRuntimeInt As Int = 0 Dim logsEnabledRuntimeInt As Int = 0
If isLogsEnabledRuntime Then If isLogsEnabledRuntime Then
logsEnabledRuntimeInt = 1 logsEnabledRuntimeInt = 1
End If End If
sbInfo.Append($"EnableSQLiteLogs: ${logsEnabledRuntimeInt} (0=Deshabilitado, 1=Habilitado)"$).Append(CRLF) sbInfo.Append($"EnableSQLiteLogs: ${logsEnabledRuntimeInt} (0=Disabled, 1=Enabled)"$).Append(CRLF)
sbInfo.Append(CRLF) sbInfo.Append(CRLF)
Else Else
sbInfo.Append($"ERROR: Conector ${dbKey} no inicializado o falló al inicio."$).Append(CRLF).Append(CRLF) sbInfo.Append($"ERROR: Connector ${dbKey} not initialized or failed at startup."$).Append(CRLF).Append(CRLF)
End If End If
Next Next
resp.Write(sbInfo.ToString) resp.Write(sbInfo.ToString)
Return Return
@@ -505,24 +557,22 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
Dim dbKeyToChange As String = req.GetParameter("db").ToUpperCase Dim dbKeyToChange As String = req.GetParameter("db").ToUpperCase
Dim status As String = req.GetParameter("status") Dim status As String = req.GetParameter("status")
If Main.listaDeCP.IndexOf(dbKeyToChange) = -1 Then If Main.listaDeCP.IndexOf(dbKeyToChange) = -1 Then
resp.Write($"ERROR: DBKey '${dbKeyToChange}' no es válida."$) resp.Write($"ERROR: DBKey '${dbKeyToChange}' is not valid."$)
Return Return
End If End If
Dim isEnabled As Boolean = (status = "1") Dim isEnabled As Boolean = (status = "1")
Dim resultMsg As String Dim resultMsg As String
' *** 1. Adquisición del Lock (CRÍTICO) ***
Main.MainConnectorsLock.RunMethod("lock", Null) Main.MainConnectorsLock.RunMethod("lock", Null)
Try Try
' 2. Lógica Crítica de Modificación de Estado (Protegida)
Main.SQLiteLoggingStatusByDB.Put(dbKeyToChange, isEnabled) Main.SQLiteLoggingStatusByDB.Put(dbKeyToChange, isEnabled)
Private hab As String = "DESHABILITADOS" Private hab As String = "DISABLED"
If isEnabled Then hab = "HABILITADOS" If isEnabled Then hab = "ENABLED"
resultMsg = $"Logs de ${dbKeyToChange} ${hab} en caliente."$ resultMsg = $"Logs for ${dbKeyToChange} ${hab} on-the-fly."$
' 3. Re-evaluación del estado global
Main.IsAnySQLiteLoggingEnabled = False Main.IsAnySQLiteLoggingEnabled = False
For Each dbKey As String In Main.listaDeCP For Each dbKey As String In Main.listaDeCP
If Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False) Then If Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False) Then
@@ -531,27 +581,21 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
End If End If
Next Next
' 4. Ajustar el Timer
If Main.IsAnySQLiteLoggingEnabled Then If Main.IsAnySQLiteLoggingEnabled Then
If Main.timerLogs.Enabled = False Then Main.timerLogs.Enabled = True If Main.timerLogs.Enabled = False Then Main.timerLogs.Enabled = True
resultMsg = resultMsg & " Timer de limpieza ACTIVADO." resultMsg = resultMsg & " Cleanup timer ACTIVATED."
Else Else
Main.timerLogs.Enabled = False Main.timerLogs.Enabled = False
resultMsg = resultMsg & " Timer de limpieza DESHABILITADO globalmente." resultMsg = resultMsg & " Cleanup timer DISABLED globally."
End If End If
' ** LIBERACIÓN EN CASO DE ÉXITO **
' En el camino de éxito, liberamos inmediatamente antes de que la subrutina termine.
If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then
Main.MainConnectorsLock.RunMethod("unlock", Null) Main.MainConnectorsLock.RunMethod("unlock", Null)
End If End If
Catch Catch
' 5. Manejo de Excepción y ** LIBERACIÓN EN CASO DE FALLO ** resultMsg = $"CRITICAL ERROR modifying log status: ${LastException.Message}"$
resultMsg = $"ERROR CRÍTICO al modificar el estado de logs: ${LastException.Message}"$
' ¡ESTE ES EL EQUIVALENTE AL FINALLY EN B4X!
' Verificamos si este hilo retiene el lock y, si es así, lo liberamos de inmediato.
If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then
Main.MainConnectorsLock.RunMethod("unlock", Null) Main.MainConnectorsLock.RunMethod("unlock", Null)
End If End If
@@ -559,10 +603,10 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
resp.Write(resultMsg) resp.Write(resultMsg)
Return Return
Case Else Case Else
resp.ContentType = "text/plain; charset=utf-8" resp.ContentType = "text/plain; charset=utf-8"
resp.SendError(404, $"Comando desconocido: '{Command}'"$) resp.SendError(404, $"Unknown command: '{Command}'"$)
Return Return
End Select End Select
End Sub End Sub

52
ParameterValidationUtils.bas
View File

@@ -4,43 +4,43 @@ ModulesStructureVersion=1
Type=StaticCode Type=StaticCode
Version=10.3 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
' Archivo: ParameterValidationUtils.bas ' File: ParameterValidationUtils.bas
' Módulo de utilidad: ParameterValidationUtils ' Utility module: ParameterValidationUtils
' Centraliza la lógica de validación y ajuste de parámetros SQL. ' Centralizes SQL parameter validation and adjustment logic.
' Ahora soporta recorte de parámetros excesivos. ' Now supports trimming of excessive parameters.
Sub Process_Globals Sub Process_Globals
' El Type ParameterValidationResult está declarado en Main.bas, no se declara aquí. ' The ParameterValidationResult Type is declared in Main.bas, not here.
End Sub End Sub
' Valida y ajusta la lista de parámetros para la ejecución SQL, aplicando la lógica de tolerancia. ' Validates and adjusts the parameter list for SQL execution, applying tolerance logic.
' Retorna un ParameterValidationResult indicando éxito/error y los parámetros a usar. ' Returns a ParameterValidationResult indicating success/error and the parameters to use.
Public Sub ValidateAndAdjustParameters (CommandName As String, DBKey As String, sqlCommand As String, receivedParams As List, IsToleranceEnabled As Boolean) As ParameterValidationResult Public Sub ValidateAndAdjustParameters (CommandName As String, DBKey As String, sqlCommand As String, receivedParams As List, IsToleranceEnabled As Boolean) As ParameterValidationResult
Dim res As ParameterValidationResult Dim res As ParameterValidationResult
res.Initialize res.Initialize
res.Success = True ' Asumimos éxito inicialmente res.Success = True ' Assume success initially
' Log(">>>> IsToleranceEnabled: " & IsToleranceEnabled) ' Log(">>>> IsToleranceEnabled: " & IsToleranceEnabled)
' Aseguramos que receivedParams esté inicializada, incluso si está vacía o Null ' Ensure receivedParams is initialized, even if it's empty or Null
If receivedParams = Null Or receivedParams.IsInitialized = False Then If receivedParams = Null Or receivedParams.IsInitialized = False Then
receivedParams.Initialize ' Inicializa una lista vacía si es Null o no inicializada. receivedParams.Initialize ' Initialize an empty list if Null or uninitialized.
End If End If
' Contar cuántos '?' hay en la sentencia SQL para saber cuántos parámetros se esperan. ' Count how many '?' are in the SQL statement to know how many parameters are expected.
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
Dim receivedParamsSize As Int = receivedParams.Size Dim receivedParamsSize As Int = receivedParams.Size
If receivedParamsSize < expectedParams Then If receivedParamsSize < expectedParams Then
' Caso 1: Se recibieron MENOS parámetros de los esperados. Esto es un error. ' Fewer parameters were received than expected. This is an error.
res.Success = False res.Success = False
res.ErrorMessage = $"ERROR: Número de parámetros insuficiente para "${CommandName}" (DB: ${DBKey}). Se esperaban ${expectedParams} y se recibieron ${receivedParamsSize}."$ res.ErrorMessage = $"ERROR: Insufficient number of parameters for "${CommandName}" (DB: ${DBKey}). Expected ${expectedParams} and received ${receivedParamsSize}."$
Log(res.ErrorMessage) Log(res.ErrorMessage)
Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null) ' <-- Nuevo Log Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null)
Return res Return res
Else If receivedParamsSize > expectedParams Then Else If receivedParamsSize > expectedParams Then
' Caso 2: Se recibieron MÁS parámetros de los esperados. ' More parameters were received than expected.
If IsToleranceEnabled Then ' Solo recortamos si la tolerancia está habilitada If IsToleranceEnabled Then ' We only trim if tolerance is enabled
Dim adjustedParams As List Dim adjustedParams As List
adjustedParams.Initialize adjustedParams.Initialize
For i = 0 To expectedParams - 1 For i = 0 To expectedParams - 1
@@ -48,23 +48,23 @@ Public Sub ValidateAndAdjustParameters (CommandName As String, DBKey As String,
Next Next
res.ParamsToExecute = adjustedParams res.ParamsToExecute = adjustedParams
res.Success = True res.Success = True
Dim WarningMsg As String = $"ADVERTENCIA: Se recibieron más parámetros de los esperados para "${CommandName}" (DB: ${DBKey}). Se esperaban ${expectedParams} y se recibieron ${receivedParamsSize}. Se ajustó la lista de parámetros a ${expectedParams} elementos."$ Dim WarningMsg As String = $"WARNING: More parameters received than expected for "${CommandName}" (DB: ${DBKey}). Expected ${expectedParams} and received ${receivedParamsSize}. Adjusted parameter list to ${expectedParams} items."$
' Log(WarningMsg) ' Log(WarningMsg)
' Log("Cache: " & Main.LOG_CACHE_THRESHOLD & "|" & Main.ErrorLogCache.Size) ' Log("Cache: " & Main.LOG_CACHE_THRESHOLD & "|" & Main.ErrorLogCache.Size)
Main.LogServerError("ADVERTENCIA", "ParameterValidationUtils.ValidateAndAdjustParameters", WarningMsg, DBKey, CommandName, Null) Main.LogServerError("WARNING", "ParameterValidationUtils.ValidateAndAdjustParameters", WarningMsg, DBKey, CommandName, Null)
Else Else
' Si la tolerancia NO está habilitada, esto es un error crítico. ' If tolerance is NOT enabled, this is a critical error.
res.Success = False res.Success = False
res.ErrorMessage = $"ERROR: Número de parámetros excesivo para "${CommandName}" (DB: ${DBKey}). Se esperaban ${expectedParams} y se recibieron ${receivedParamsSize}. La tolerancia a parámetros extra está DESHABILITADA."$ res.ErrorMessage = $"ERROR: Excessive number of parameters for "${CommandName}" (DB: ${DBKey}). Expected ${expectedParams} and received ${receivedParamsSize}. Extra parameter tolerance is DISABLED."$
Log(res.ErrorMessage) Log(res.ErrorMessage)
Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null) Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null)
Return res Return res
End If End If
Else Else
' Caso 3: Se recibieron el número EXACTO de parámetros. Todo bien. ' The EXACT number of parameters was received. All good.
res.ParamsToExecute = receivedParams ' Usamos la lista original tal cual. res.ParamsToExecute = receivedParams ' Use the original list as-is.
res.Success = True ' Confirmamos éxito. res.Success = True ' Confirm success.
End If End If
Return res Return res
End Sub End Sub

155
RDCConnector.bas
View File

@@ -4,171 +4,167 @@ ModulesStructureVersion=1
Type=Class Type=Class
Version=4.19 Version=4.19
@EndOfDesignText@ @EndOfDesignText@
' Módulo de clase: RDCConnector ' Class module: RDCConnector
' Esta clase gestiona el pool de conexiones a una base de datos específica. ' This class manages the connection pool for a specific database.
' REFRACTORIZADO: Usa ConnectionPoolManager y delega a HikariCP. ' Uses ConnectionPoolManager and delegates to HikariCP.
Sub Class_Globals Sub Class_Globals
' --- Variables globales de la clase --- ' --- Class global variables ---
Private pool As ConnectionPoolManager ' Usa el Manager para la modularidad Private MyHikariPool As HikariConnectionPool ' Dedicated pool for this DBKey.
Private MyHikariPool As HikariConnectionPool ' <-- NUEVO: Pool dedicado a esta DBKey. Private DebugQueries As Boolean = False ' Flag to enable/disable debug mode
Private DebugQueries As Boolean = False ' Bandera para activar/desactivar el modo de depuración Public commands As Map ' Loaded SQL commands
Public commands As Map ' Comandos SQL cargados
Public serverPort As Int Public serverPort As Int
Public usePool As Boolean = True Public usePool As Boolean = True
Public config As Map ' Configuración completa (JdbcUrl, User, Password, etc.) Public config As Map ' Complete configuration (JdbcUrl, User, Password, etc.)
Public IsParameterToleranceEnabled As Boolean ' Tolerancia a parámetros de más Public IsParameterToleranceEnabled As Boolean ' Tolerance for extra parameters
Dim driverProperties As Map ' CRÍTICO: Propiedades específicas del driver (MySQL statement caching) Dim driverProperties As Map ' Specific driver properties (MySQL statement caching)
Private configLocation As String ' Ubicación del archivo de configuración Private configLocation As String ' Configuration file location
Private poolProperties As Map Private poolProperties As Map
End Sub End Sub
' Subrutina de inicialización para el conector de una base de datos específica. ' Initialization subroutine for a specific database connector.
Public Sub Initialize(DB As String) Public Sub Initialize(DB As String)
' Nota: Este código asume que MyHikariPool ya está declarado en Class_Globals ' Note: This code assumes MyHikariPool is already declared in Class_Globals
Dim dbKey As String = DB ' Usaremos DB como la llave Dim dbKey As String = DB ' We will use DB as the key
If DB.EqualsIgnoreCase("DB1") Then dbKey = "" If DB.EqualsIgnoreCase("DB1") Then dbKey = ""
poolProperties.Initialize poolProperties.Initialize
driverProperties.Initialize driverProperties.Initialize
' PASO 1: Cargar la configuración desde el archivo .properties correspondiente. ' Load the configuration from the corresponding .properties file.
config = LoadConfigMap(dbKey) ' Aseguramos la carga en la variable de clase [1] config = LoadConfigMap(dbKey) ' Ensure it's loaded into the class variable
' Lectura de la configuración de tolerancia de parámetros ' Read the parameter tolerance configuration
Dim toleranceSetting As Int = config.GetDefault("parameterTolerance", 0).As(Int) Dim toleranceSetting As Int = config.GetDefault("parameterTolerance", 0).As(Int)
IsParameterToleranceEnabled = (toleranceSetting = 1) IsParameterToleranceEnabled = (toleranceSetting = 1)
If IsParameterToleranceEnabled Then If IsParameterToleranceEnabled Then
Log($"RDCConnector.Initialize para ${dbKey}: Tolerancia a parámetros extras, HABILITADA."$) Log($"RDCConnector.Initialize for ${dbKey}: Extra parameter tolerance ENABLED."$)
Else Else
Log($"RDCConnector.Initialize para ${dbKey}: Tolerancia a parámetros extras, DESHABILITADA (modo estricto)."$) Log($"RDCConnector.Initialize for ${dbKey}: Extra parameter tolerance DISABLED (strict mode)."$)
End If End If
' Bloque Try-Catch para la inicialización y configuración del pool. ' Try-Catch block for pool initialization and configuration.
Try Try
Dim driverClass As String = config.Get("DriverClass") Dim driverClass As String = config.Get("DriverClass")
Dim jdbcUrl As String = config.Get("JdbcUrl") Dim jdbcUrl As String = config.Get("JdbcUrl")
Dim aUser As String = config.Get("User") Dim aUser As String = config.Get("User")
Dim aPassword As String = config.Get("Password") Dim aPassword As String = config.Get("Password")
Dim poolType As String = "Hikari" ' Forzamos Hikari Dim poolType As String = "Hikari" ' Force Hikari
' *** INICIO DE LA LÓGICA DE PRECEDENCIA DE TAMAÑO (HIKARI) *** ' --- Size precedence logic (HIKARI) ---
Dim maxSizeKey As String = $"pool.${poolType.ToLowerCase}.maximumpoolsize"$ Dim maxSizeKey As String = $"pool.${poolType.ToLowerCase}.maximumpoolsize"$
Dim poolSizeString As String Dim poolSizeString As String
Dim poolSize As Int Dim poolSize As Int
' Intentamos leer el valor específico (pool.hikari.maximumpoolsize). ' Attempt to read the specific value (pool.hikari.maximumpoolsize).
If config.ContainsKey(maxSizeKey) Then If config.ContainsKey(maxSizeKey) Then
poolSizeString = config.Get(maxSizeKey) poolSizeString = config.Get(maxSizeKey)
poolSize = poolSizeString.As(Int) poolSize = poolSizeString.As(Int)
Else Else
' Si no está definido, usamos el default recomendado por Hikari (10). [2] ' If not defined, use the recommended Hikari default (10).
poolSize = 10 poolSize = 10
End If End If
If poolSize < 1 Then poolSize = 10 ' Mantenemos la sensatez If poolSize < 1 Then poolSize = 10 ' Keep it sensible
Log($"RDCConnector: Usando MaximumPoolSize para ${poolType} calculado: ${poolSize}"$) Log($"RDCConnector: Using MaximumPoolSize for ${poolType} calculated: ${poolSize}"$)
' *** PASO 2: INICIALIZA/CREA EL POOL LOCALMENTE (Decoupling CRÍTICO) *** ' Initialize/Create the pool locally
If MyHikariPool.IsInitialized = False Then MyHikariPool.Initialize ' Inicializa el wrapper local If MyHikariPool.IsInitialized = False Then MyHikariPool.Initialize ' Initialize the local wrapper
' Crea el pool subyacente (DataSource) en esta instancia dedicada. [3] ' Create the underlying pool (DataSource) in this dedicated instance.
MyHikariPool.CreatePool2(driverClass, jdbcUrl, aUser, aPassword, poolSize) MyHikariPool.CreatePool2(driverClass, jdbcUrl, aUser, aPassword, poolSize)
' PASO 3a: Cargar y filtrar SOLO las propiedades del Pool (ej. las que comienzan con 'pool.hikari.') ' Load and filter ONLY the Pool properties (e.g., those starting with 'pool.hikari.')
LoadPoolProperties(poolType, config) LoadPoolProperties(poolType, config)
' PASO 3b: Aplicar propiedades de ESTABILIDAD (Pool Properties) ' Apply STABILITY properties (Pool Properties)
If poolProperties.Size > 0 Then If poolProperties.Size > 0 Then
' Aplicación directa al pool local. [4] ' Direct application to the local pool.
CallSub2(MyHikariPool, "SetProperties", poolProperties) CallSub2(MyHikariPool, "SetProperties", poolProperties)
End If End If
' PASO 4: Cargar propiedades específicas del Driver (ej. Statement Caching) ' Load specific Driver properties (e.g., Statement Caching)
If config.ContainsKey("DriverShortName") Then If config.ContainsKey("DriverShortName") Then
LoadDriverProperties(config.Get("DriverShortName"), config) LoadDriverProperties(config.Get("DriverShortName"), config)
End If End If
' PASO 5: Aplicar propiedades de RENDIMIENTO (Driver Properties) ' Apply PERFORMANCE properties (Driver Properties)
If driverProperties.Size > 0 Then If driverProperties.Size > 0 Then
' Aplicación directa al pool local. [5] ' Direct application to the local pool.
CallSub2(MyHikariPool, "SetDriverProperties", driverProperties) CallSub2(MyHikariPool, "SetDriverProperties", driverProperties)
Log($"RDCConnector.Initialize para ${DB}: {driverProperties.Size} propiedades del Driver aplicadas a HikariCP."$) Log($"RDCConnector.Initialize for ${DB}: {driverProperties.Size} Driver properties applied to HikariCP."$)
End If End If
' PASO 6 (Prueba de vida): Forzar la creación de conexiones iniciales y verificar el estado. ' Force initial connection creation and check status.
' Esto garantiza el fail-fast. [6] ' This ensures fail-fast.
Dim tempCon As SQL = MyHikariPool.GetConnection Dim tempCon As SQL = MyHikariPool.GetConnection
If tempCon.IsInitialized Then If tempCon.IsInitialized Then
tempCon.Close tempCon.Close
End If End If
' Cargar configuración estática en el cache global ' Load static configuration into the global cache
Dim dbKeyToStore As String = DB Dim dbKeyToStore As String = DB
If dbKeyToStore = "" Then dbKeyToStore = "DB1" If dbKeyToStore = "" Then dbKeyToStore = "DB1"
' Almacenamos el mapa completo (configuración estática + métricas dinámicas iniciales) en el cache global. ' Store the complete map (static config + initial dynamic metrics) in the global cache.
' GetPoolStats ahora usa MyHikariPool. ' GetPoolStats now uses MyHikariPool.
Dim initialPoolStats As Map = GetPoolStats Dim initialPoolStats As Map = GetPoolStats
Main.LatestPoolStats.Put(dbKeyToStore, initialPoolStats) Main.LatestPoolStats.Put(dbKeyToStore, initialPoolStats)
Catch Catch
' Si ocurre un error durante la inicialización del pool o al forzar la conexión. ' If an error occurs during pool initialization or when forcing the connection.
Dim ErrorMsg As String = $"RDCConnector.Initialize para ${DB}: ERROR CRÍTICO al inicializar/forzar conexión: ${LastException.Message}"$ Dim ErrorMsg As String = $"RDCConnector.Initialize for ${DB}: CRITICAL ERROR initializing/forcing connection: ${LastException.Message}"$
Log(ErrorMsg) Log(ErrorMsg)
Main.LogServerError("ERROR", "RDCConnector.Initialize", ErrorMsg, DB, Null, Null) Main.LogServerError("ERROR", "RDCConnector.Initialize", ErrorMsg, DB, Null, Null)
' Si falla la inicialización, la instancia local MyHikariPool se queda inutilizada. ' If initialization fails, the local MyHikariPool instance remains unusable.
' Aquí podríamos considerar la opción de llamar a MyHikariPool.ClosePool para asegurar ' We could consider calling MyHikariPool.ClosePool here to ensure
' que no queden recursos parciales, aunque HikariCP debería manejarse con fail-fast. ' that no partial resources are left, although HikariCP should handle fail-fast.
End Try End Try
' Carga los comandos SQL predefinidos de esta base de datos en el mapa global 'commandsMap' de Main. ' Load predefined SQL commands for this database into Main's global 'commandsMap'.
If dbKey = "" Then dbKey = "DB1" If dbKey = "" Then dbKey = "DB1"
LoadSQLCommands(config, dbKey) LoadSQLCommands(config, dbKey)
serverPort = config.Get("ServerPort") serverPort = config.Get("ServerPort")
End Sub End Sub
' Carga el mapa de configuración ' Load the configuration map
Private Sub LoadConfigMap(DB As String) As Map Private Sub LoadConfigMap(DB As String) As Map
Private DBX As String = "" Private DBX As String = ""
If DB <> "" Then DBX = "." & DB If DB <> "" Then DBX = "." & DB
Log($"RDCConnector.LoadConfigMap: Leemos el config${DBX}.properties"$) Log($"RDCConnector.LoadConfigMap: Reading config${DBX}.properties"$)
Return File.ReadMap("./", "config" & DBX & ".properties") Return File.ReadMap("./", "config" & DBX & ".properties")
End Sub End Sub
' Obtiene la sentencia SQL completa para un comando dado. ' Get the complete SQL statement for a given command.
Public Sub GetCommand(DB As String, Key As String) As String Public Sub GetCommand(DB As String, Key As String) As String
commands = Main.commandsMap.Get(DB).As(Map) commands = Main.commandsMap.Get(DB).As(Map)
If commands.ContainsKey("sql." & Key) = False Then If commands.ContainsKey("sql." & Key) = False Then
Dim ErrorMsg As String = $"RDCConnector.GetCommand: *** Comando no encontrado: '${Key}' para DB: '${DB}' ***"$ Dim ErrorMsg As String = $"RDCConnector.GetCommand: *** Command not found: '${Key}' for DB: '${DB}' ***"$
Log(ErrorMsg) Log(ErrorMsg)
Main.LogServerError("ERROR", "RDCConnector.GetCommand", ErrorMsg, DB, Key, Null) Main.LogServerError("ERROR", "RDCConnector.GetCommand", ErrorMsg, DB, Key, Null)
End If End If
Return commands.Get("sql." & Key) Return commands.Get("sql." & Key)
End Sub End Sub
' Obtiene una conexión SQL funcional del pool de conexiones. ' Get a functional SQL connection from the connection pool.
Public Sub GetConnection(DB As String) As SQL Public Sub GetConnection(DB As String) As SQL
' If DB.EqualsIgnoreCase("DB1") Then DB = "" ' El ConnectionPoolManager ha sido removido. La delegación debe ir directamente
' If DebugQueries Then LoadSQLCommands(LoadConfigMap(DB), DB) ' Deshabilitado por defecto. [13] ' al pool dedicado de HikariCP. Esto simplifica la ruta crítica.
' Devolvemos la conexión del pool local, si está inicializado.
If MyHikariPool.IsInitialized Then If MyHikariPool.IsInitialized Then
Return MyHikariPool.GetConnection Return MyHikariPool.GetConnection
Else Else
Log($"ERROR: Intento de obtener conexión de DBKey ${DB}, pero MyHikariPool no está inicializado."$) Log($"ERROR: Attempt to get connection for DBKey ${DB}, but MyHikariPool is not initialized."$)
' Devolver Null o lanzar excepción, dependiendo del manejo de errores deseado. ' Es crucial retornar Null si no está inicializado para que el handler capture el error.
Return Null Return Null
End If End If
' ANTES: Return Main.ConnectionPoolManager1.GetConnection
End Sub End Sub
' Carga todos los comandos SQL del mapa de configuración en el mapa global 'commandsMap' de Main. ' Load all SQL commands from the config map into Main's global 'commandsMap'.
Private Sub LoadSQLCommands(config2 As Map, DB As String) Private Sub LoadSQLCommands(config2 As Map, DB As String)
Dim newCommands As Map Dim newCommands As Map
newCommands.Initialize newCommands.Initialize
@@ -181,48 +177,45 @@ Private Sub LoadSQLCommands(config2 As Map, DB As String)
Main.commandsMap.Put(DB, commands) Main.commandsMap.Put(DB, commands)
End Sub End Sub
' ** Delegación de estadísticas de C3P0 a HikariCP ** ' Delegation of statistics from C3P0 to HikariCP
Public Sub GetPoolStats As Map Public Sub GetPoolStats As Map
Dim stats As Map Dim stats As Map
stats.Initialize stats.Initialize
If MyHikariPool.IsInitialized Then If MyHikariPool.IsInitialized Then
Try Try
' 2. Llamamos al método delegado GetStats en el wrapper de HikariCP. ' 2. Call the delegated GetStats method in the HikariCP wrapper.
Dim hikariStats As Map = MyHikariPool.GetStats Dim hikariStats As Map = MyHikariPool.GetStats
Return hikariStats Return hikariStats
Catch Catch
' Fallo en el método GetStats del wrapper. ' Failure in the wrapper's GetStats method.
Dim ErrorMsg As String = $"RDCConnector.GetPoolStats: ERROR CRÍTICO al obtener estadísticas de HikariCP: ${LastException.Message}"$ Dim ErrorMsg As String = $"RDCConnector.GetPoolStats: CRITICAL ERROR getting stats from HikariCP: ${LastException.Message}"$
Log(ErrorMsg) Log(ErrorMsg)
stats.Put("Error", LastException.Message) stats.Put("Error", LastException.Message)
End Try End Try
Else Else
stats.Put("Error", "Pool local MyHikariPool no inicializado.") stats.Put("Error", "Local pool MyHikariPool not initialized.")
End If End If
Return stats Return stats
End Sub End Sub
' *** NUEVA SUBRUTINA: Cierra el pool de conexiones de forma ordenada *** ' Close the connection pool cleanly
Public Sub Close Public Sub Close
If MyHikariPool.IsInitialized Then If MyHikariPool.IsInitialized Then
' Cierre limpio del pool subyacente. ' Clean closure of the underlying pool.
MyHikariPool.ClosePool MyHikariPool.ClosePool
Log($"RDCConnector.Close: Pool Hikari cerrado limpiamente para este conector."$) Log($"RDCConnector.Close: Hikari pool closed cleanly for this connector."$)
End If End If
' Ya NO delegamos el cierre al Manager. ' La línea de delegación a Main.ConnectionPoolManager1.ClosePoolByType(poolType) ha sido eliminada.
' ANTES: Main.ConnectionPoolManager1.ClosePoolByType(poolType) [15]
End Sub End Sub
' --- SUBRUTINAS DE UTILIDAD PARA CARGA DE PROPIEDADES --- ' --- UTILITY SUBROUTINES FOR LOADING PROPERTIES ---
' [2]
Private Sub LoadDriverProperties(driverShortName As String, config_ As Map) Private Sub LoadDriverProperties(driverShortName As String, config_ As Map)
driverProperties = ExtractProperties($"driver.${driverShortName.trim}."$, config_, Null, Null) driverProperties = ExtractProperties($"driver.${driverShortName.trim}."$, config_, Null, Null)
End Sub End Sub
' [3]
Private Sub ExtractProperties(prefix As String, input As Map, newPrefix As String, output As Map) As Map Private Sub ExtractProperties(prefix As String, input As Map, newPrefix As String, output As Map) As Map
Dim properties As Map Dim properties As Map
If output = Null Or output.IsInitialized = False Then If output = Null Or output.IsInitialized = False Then
@@ -232,7 +225,7 @@ Private Sub ExtractProperties(prefix As String, input As Map, newPrefix As Strin
End If End If
If newPrefix.EqualsIgnoreCase(Null) Then newPrefix = "" If newPrefix.EqualsIgnoreCase(Null) Then newPrefix = ""
Dim prefixLength As Int = prefix.Length Dim prefixLength As Int = prefix.Length
' Log($"Prefijo=${prefix}, ${newPrefix}"$) ' Log($"Prefijo=${prefix}, ${newPrefix}"$)
For Each k As String In input.Keys For Each k As String In input.Keys
' Log(k) ' Log(k)
@@ -243,11 +236,11 @@ Private Sub ExtractProperties(prefix As String, input As Map, newPrefix As Strin
properties.Put($"${newPrefix}${standardizedKey}"$, input.Get(k)) properties.Put($"${newPrefix}${standardizedKey}"$, input.Get(k))
End If End If
Next Next
Return properties Return properties
End Sub End Sub
Private Sub LoadPoolProperties(poolType As String, config_ As Map) Private Sub LoadPoolProperties(poolType As String, config_ As Map)
' Busca entradas como 'pool.hikari.<propiedad>' y las extrae. ' Find entries like 'pool.hikari.<property>' and extract them.
poolProperties = ExtractProperties($"pool.${poolType.ToLowerCase}."$, config_, Null, Null) poolProperties = ExtractProperties($"pool.${poolType.ToLowerCase}."$, config_, Null, Null)
End Sub End Sub

451
jRDC_Multi.b4j
View File

@@ -30,26 +30,25 @@ Library7=jshell
Library8=json Library8=json
Library9=jsql Library9=jsql
Module1=Cambios Module1=Cambios
Module10=LoginHandler Module10=LogoutHandler
Module11=LogoutHandler Module11=Manager
Module12=Manager Module12=ParameterValidationUtils
Module13=ParameterValidationUtils Module13=ping
Module14=ping Module14=RDCConnector
Module15=RDCConnector Module15=SSE
Module16=SSE Module16=SSEHandler
Module17=SSEHandler Module17=TestHandler
Module18=TestHandler
Module2=ChangePassHandler Module2=ChangePassHandler
Module3=ConnectionPoolManager Module3=DBHandlerB4X
Module4=DBHandlerB4X Module4=DBHandlerJSON
Module5=DBHandlerJSON Module5=DoLoginHandler
Module6=DoLoginHandler Module6=faviconHandler
Module7=faviconHandler Module7=GlobalParameters
Module8=GlobalParameters Module8=HikariConnectionPool
Module9=HikariConnectionPool Module9=LoginHandler
NumberOfFiles=9 NumberOfFiles=9
NumberOfLibraries=9 NumberOfLibraries=9
NumberOfModules=18 NumberOfModules=17
Version=10.3 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
'Non-UI application (console / server application) 'Non-UI application (console / server application)
@@ -95,51 +94,42 @@ Version=10.3
Sub Process_Globals Sub Process_Globals
' The main B4J HTTP server object ' The main B4J HTTP server object
Public srvr As Server Public srvr As Server
' The current version of this modified jRDC server ' The current version of this modified jRDC server
Public const VERSION As Float = 2.23 Public const VERSION As Float = 2.23
' Custom types for serializing/deserializing data ' Custom types for serializing/deserializing data
Type DBCommand (Name As String, Parameters() As Object) Type DBCommand (Name As String, Parameters() As Object)
Type DBResult (Tag As Object, Columns As Map, Rows As List) Type DBResult (Tag As Object, Columns As Map, Rows As List)
' Holds a list of configured database identifiers (e.g., "DB1", "DB2") ' Holds a list of configured database identifiers (e.g., "DB1", "DB2")
Public listaDeCP As List Public listaDeCP As List
' A temporary list to store found configuration file names during startup ' A temporary list to store found configuration file names during startup
Private cpFiles As List Private cpFiles As List
' Global maps to manage database connectors and loaded SQL commands ' Global maps to manage database connectors and loaded SQL commands
Public Connectors, commandsMap As Map Public Connectors, commandsMap As Map
' SQL object for interacting with the local users database (Authentication)
' SQL object for interacting with the local users and logs database (SQLite) Public SQL_Auth As SQL ' --- NEW INSTANCE FOR AUTHENTICATION
Public SQL1 As SQL ' SQL object for interacting with the local logs database (Performance/Errors)
Public SQL_Logs As SQL ' --- NEW INSTANCE FOR LOGS
' Defines the storage mode for the Log database (SQL_Logs). Default is DISK.
' Options: "DISK" (persistent) or "MEMORY" (in-memory, lost on exit).
Private const LOG_DB_MODE As String = "DISK"
' Object for securely hashing and verifying passwords ' Object for securely hashing and verifying passwords
Private bc As BCrypt Private bc As BCrypt
' A Java ReentrantLock object to protect Main.Connectors during Hot-Swapping (thread-safety) ' A Java ReentrantLock object to protect Main.Connectors during Hot-Swapping (thread-safety)
Public MainConnectorsLock As JavaObject Public MainConnectorsLock As JavaObject
' A Java ReentrantLock object to protect the log caches (QueryLogCache and ErrorLogCache) ' A Java ReentrantLock object to protect the log caches (QueryLogCache and ErrorLogCache)
Public LogCacheLock As JavaObject Public LogCacheLock As JavaObject
' Timer for executing periodic tasks, such as log cleanup ' Timer for executing periodic tasks, such as log cleanup
Public timerLogs As Timer Public timerLogs As Timer
' Map to store the SQLite logging status (True/False) for each DBKey (DB1, DB2, etc.) ' Map to store the SQLite logging status (True/False) for each DBKey (DB1, DB2, etc.)
Public SQLiteLoggingStatusByDB As Map Public SQLiteLoggingStatusByDB As Map
' Global flag indicating if AT LEAST one database has SQLite logging enabled ' Global flag indicating if AT LEAST one database has SQLite logging enabled
Public IsAnySQLiteLoggingEnabled As Boolean Public IsAnySQLiteLoggingEnabled As Boolean
' Type to encapsulate the result of parameter validation ' Type to encapsulate the result of parameter validation
Type ParameterValidationResult ( _ Type ParameterValidationResult ( _
Success As Boolean, _ Success As Boolean, _
ErrorMessage As String, _ ErrorMessage As String, _
ParamsToExecute As List _ ' The final list of parameters to use in the SQL execution ParamsToExecute As List _ ' The final list of parameters to use in the SQL execution
) )
' In-memory cache for performance logs (query_logs) ' In-memory cache for performance logs (query_logs)
Public QueryLogCache As List Public QueryLogCache As List
' In-memory cache for error and warning logs ' In-memory cache for error and warning logs
@@ -156,13 +146,11 @@ Sub Process_Globals
Private const VACUUM_CYCLES As Int = 48 Private const VACUUM_CYCLES As Int = 48
' Granular control for TEXT file logging (CSV) ' Granular control for TEXT file logging (CSV)
Public TextLoggingStatusByDB As Map Public TextLoggingStatusByDB As Map
' Main object for managing all connection pools (RDCConnector instances)
Public ConnectionPoolManager1 As ConnectionPoolManager
End Sub End Sub
' --- Main application entry point --- ' --- Main application entry point ---
Sub AppStart (Args() As String) Sub AppStart (Args() As String)
' Initialize Server-Sent Events handler ' Initialize Server-Sent Events handler
SSE.Initialize SSE.Initialize
' Set logger flag based on build mode (DEBUG or RELEASE) ' Set logger flag based on build mode (DEBUG or RELEASE)
@@ -173,13 +161,13 @@ Sub AppStart (Args() As String)
#else #else
logger = False logger = False
#End If #End If
Log("LOG_CACHE_THRESHOLD: " & LOG_CACHE_THRESHOLD) Log("Log_Cache_Threshold: " & LOG_CACHE_THRESHOLD)
' Copy web admin panel files if they don't exist ' Copy web admin panel files if they don't exist
CopiarRecursoSiNoExiste("manager.html", "www") CopiarRecursoSiNoExiste("manager.html", "www")
CopiarRecursoSiNoExiste("login.html", "www") CopiarRecursoSiNoExiste("login.html", "www")
' Copy root files (configs, start/stop scripts) if they don't exist ' Copy root files (configs, start/stop scripts) if they don't exist
CopiarRecursoSiNoExiste("config.properties", "") CopiarRecursoSiNoExiste("config.properties", "")
' CopiarRecursoSiNoExiste("config.DB2.properties", "") ' CopiarRecursoSiNoExiste("config.DB2.properties", "")
@@ -189,16 +177,16 @@ Sub AppStart (Args() As String)
CopiarRecursoSiNoExiste("stop.bat", "") CopiarRecursoSiNoExiste("stop.bat", "")
CopiarRecursoSiNoExiste("reiniciaProcesoBow.bat", "") CopiarRecursoSiNoExiste("reiniciaProcesoBow.bat", "")
CopiarRecursoSiNoExiste("reiniciaProcesoPM2.bat", "") CopiarRecursoSiNoExiste("reiniciaProcesoPM2.bat", "")
' Initialize the BCrypt password hashing library ' Initialize the BCrypt password hashing library
bc.Initialize("BC") bc.Initialize("BC")
' Initialize in-memory log caches ' Initialize in-memory log caches
QueryLogCache.Initialize QueryLogCache.Initialize
ErrorLogCache.Initialize ErrorLogCache.Initialize
' === 1. Initialize the local user database (SQLite) and log tables === ' === 1. Initialize the local user database (SQLite) and log tables ===
InitializeSQLiteDatabase InitializeSQLiteDatabase
' === 2. Initialize global maps defined in GlobalParameters.bas === ' === 2. Initialize global maps defined in GlobalParameters.bas ===
GlobalParameters.mpLogs.Initialize GlobalParameters.mpLogs.Initialize
GlobalParameters.mpTotalRequests.Initialize GlobalParameters.mpTotalRequests.Initialize
@@ -228,11 +216,8 @@ Sub AppStart (Args() As String)
' Initialize the lock for log caches ' Initialize the lock for log caches
LogCacheLock.InitializeNewInstance("java.util.concurrent.locks.ReentrantLock", Null) LogCacheLock.InitializeNewInstance("java.util.concurrent.locks.ReentrantLock", Null)
' Initialize the Manager, which in turn initializes all pool wrappers.
ConnectionPoolManager1.Initialize
' === 4. INITIALIZATION OF THE MAIN DATABASE CONNECTOR (DB1) === ' === 4. INITIALIZATION OF THE MAIN DATABASE CONNECTOR (DB1) ===
Try Try
' Initialize the main 'DB1' connector ' Initialize the main 'DB1' connector
Dim con1 As RDCConnector Dim con1 As RDCConnector
@@ -244,19 +229,19 @@ Sub AppStart (Args() As String)
' Add 'DB1' to the list of active database keys ' Add 'DB1' to the list of active database keys
listaDeCP.Add("DB1") listaDeCP.Add("DB1")
Log($"Main.AppStart: Connector 'DB1' initialized successfully on port: ${srvr.Port}"$) Log($"Main.AppStart: Connector 'DB1' initialized successfully on port: ${srvr.Port}"$)
' Read the 'enableSQLiteLogs' setting from config.properties (default to 0) ' Read the 'enableSQLiteLogs' setting from config.properties (default to 0)
Dim enableLogsSetting As Int = con1.config.GetDefault("enableSQLiteLogs", 0).As(Int) Dim enableLogsSetting As Int = con1.config.GetDefault("enableSQLiteLogs", 0).As(Int)
Dim isEnabled As Boolean = (enableLogsSetting = 1) Dim isEnabled As Boolean = (enableLogsSetting = 1)
' Store the status in the granular map ' Store the status in the granular map
SQLiteLoggingStatusByDB.Put("DB1", isEnabled) SQLiteLoggingStatusByDB.Put("DB1", isEnabled)
' Read the 'enableTextLogging' setting ' Read the 'enableTextLogging' setting
Dim enableTextLogsSetting As Int = con1.config.GetDefault("enableTextLogging", 0).As(Int) Dim enableTextLogsSetting As Int = con1.config.GetDefault("enableTextLogging", 0).As(Int)
Dim isTextEnabled As Boolean = (enableTextLogsSetting = 1) Dim isTextEnabled As Boolean = (enableTextLogsSetting = 1)
' Store the text log status ' Store the text log status
TextLoggingStatusByDB.Put("DB1", isTextEnabled) TextLoggingStatusByDB.Put("DB1", isTextEnabled)
Catch Catch
' This is a critical failure; the server cannot start without DB1 ' This is a critical failure; the server cannot start without DB1
Dim ErrorMsg As String = $"Main.AppStart: CRITICAL ERROR initializing connector 'DB1': ${LastException.Message}"$ Dim ErrorMsg As String = $"Main.AppStart: CRITICAL ERROR initializing connector 'DB1': ${LastException.Message}"$
@@ -266,53 +251,53 @@ Sub AppStart (Args() As String)
' Stop the application ' Stop the application
ExitApplication ExitApplication
End Try End Try
' === 5. DETECTION AND INITIALIZATION OF ADDITIONAL DATABASES (DB2, DB3, DB4) === ' === 5. DETECTION AND INITIALIZATION OF ADDITIONAL DATABASES (DB2, DB3, DB4) ===
' Scan the application's root directory for configuration files ' Scan the application's root directory for configuration files
cpFiles = File.ListFiles("./") cpFiles = File.ListFiles("./")
If cpFiles.Size > 0 Then If cpFiles.Size > 0 Then
For Each fileName As String In cpFiles For Each fileName As String In cpFiles
Dim keyPrefix As String = "config." Dim keyPrefix As String = "config."
Dim keySuffix As String = ".properties" Dim keySuffix As String = ".properties"
' 1. Filter and exclude DB1 (which is already loaded) ' 1. Filter and exclude DB1 (which is already loaded)
' Find files matching "config.xxx.properties" but not "config.properties" ' Find files matching "config.xxx.properties" but not "config.properties"
If fileName.StartsWith(keyPrefix) And fileName.EndsWith(keySuffix) And fileName <> "config.properties" Then If fileName.StartsWith(keyPrefix) And fileName.EndsWith(keySuffix) And fileName <> "config.properties" Then
Try Try
' 2. Extract the key ("xxx" from config.xxx.properties) ' 2. Extract the key ("xxx" from config.xxx.properties)
Dim keyLength As Int = fileName.Length - keySuffix.Length Dim keyLength As Int = fileName.Length - keySuffix.Length
Dim dbKey As String = fileName.SubString2(keyPrefix.Length, keyLength) Dim dbKey As String = fileName.SubString2(keyPrefix.Length, keyLength)
' ROBUSTNESS: Ensure the key is UPPERCASE for consistency. ' ROBUSTNESS: Ensure the key is UPPERCASE for consistency.
' Handlers normalize the key to uppercase, so we must match that. ' Handlers normalize the key to uppercase, so we must match that.
dbKey = dbKey.ToUpperCase.Trim dbKey = dbKey.ToUpperCase.Trim
Log($"Main.AppStart: Configuration file detected: '${fileName}'. Initializing connector '${dbKey}'."$) Log($"Main.AppStart: Configuration file detected: '${fileName}'. Initializing connector '${dbKey}'."$)
Dim newCon As RDCConnector Dim newCon As RDCConnector
' 3. Initialize the RDC Connector (which reads its own config.dbKey.properties file) ' 3. Initialize the RDC Connector (which reads its own config.dbKey.properties file)
newCon.Initialize(dbKey) newCon.Initialize(dbKey)
' 4. Update global structures (Thread-Safe Maps) ' 4. Update global structures (Thread-Safe Maps)
Connectors.Put(dbKey, newCon) Connectors.Put(dbKey, newCon)
listaDeCP.Add(dbKey) listaDeCP.Add(dbKey)
' 5. Granular Logging Logic ' 5. Granular Logging Logic
' Capture the logging status for this new DB ' Capture the logging status for this new DB
Dim enableLogsSetting As Int = newCon.config.GetDefault("enableSQLiteLogs", 0).As(Int) Dim enableLogsSetting As Int = newCon.config.GetDefault("enableSQLiteLogs", 0).As(Int)
Dim isEnabled As Boolean = (enableLogsSetting = 1) Dim isEnabled As Boolean = (enableLogsSetting = 1)
SQLiteLoggingStatusByDB.Put(dbKey, isEnabled) SQLiteLoggingStatusByDB.Put(dbKey, isEnabled)
' Capture text logging status for this new DB ' Capture text logging status for this new DB
Dim enableTextLogsSetting As Int = newCon.config.GetDefault("enableTextLogging", 0).As(Int) Dim enableTextLogsSetting As Int = newCon.config.GetDefault("enableTextLogging", 0).As(Int)
Dim isTextEnabled As Boolean = (enableTextLogsSetting = 1) Dim isTextEnabled As Boolean = (enableTextLogsSetting = 1)
TextLoggingStatusByDB.Put(dbKey, isTextEnabled) TextLoggingStatusByDB.Put(dbKey, isTextEnabled)
Log("TEXT LOGGING STATUS BY DB: " & TextLoggingStatusByDB) Log("TEXT LOGGING STATUS BY DB: " & TextLoggingStatusByDB)
' Note: Global re-evaluation of IsAnySQLiteLoggingEnabled is done at the end of AppStart. ' Note: Global re-evaluation of IsAnySQLiteLoggingEnabled is done at the end of AppStart.
Catch Catch
' 6. Error Handling: If a file is invalid (e.g., bad credentials, malformed URL), ' 6. Error Handling: If a file is invalid (e.g., bad credentials, malformed URL),
' the server should log the error but continue trying with the next file. ' the server should log the error but continue trying with the next file.
@@ -323,7 +308,7 @@ Sub AppStart (Args() As String)
End If End If
Next Next
End If End If
' Final log of all databases the server is managing. ' Final log of all databases the server is managing.
Dim sbListaDeCP_Log As StringBuilder Dim sbListaDeCP_Log As StringBuilder
sbListaDeCP_Log.Initialize sbListaDeCP_Log.Initialize
@@ -336,10 +321,10 @@ Sub AppStart (Args() As String)
Log($"Main.AppStart: Configured and ready databases: [${sbListaDeCP_Log.ToString}]"$) Log($"Main.AppStart: Configured and ready databases: [${sbListaDeCP_Log.ToString}]"$)
' <<<< Initialization block for the log cleanup Timer >>>> ' <<<< Initialization block for the log cleanup Timer >>>>
' UNCONDITIONAL Initialization of the Timer (Ensures the object exists and prevents IllegalStateException) ' UNCONDITIONAL Initialization of the Timer (Ensures the object exists and prevents IllegalStateException)
timerLogs.Initialize("TimerLogs", 1800000) ' 30 minutes = 1800 * 1000 = 1800000 ms timerLogs.Initialize("TimerLogs", 1800000) ' 30 minutes = 1800 * 1000 = 1800000 ms
' CONDITIONAL CONTROL BASED ON GRANULAR STATUS ' CONDITIONAL CONTROL BASED ON GRANULAR STATUS
IsAnySQLiteLoggingEnabled = False IsAnySQLiteLoggingEnabled = False
For Each dbStatus As Boolean In SQLiteLoggingStatusByDB.Values For Each dbStatus As Boolean In SQLiteLoggingStatusByDB.Values
@@ -348,7 +333,7 @@ Sub AppStart (Args() As String)
Exit ' If one is active, it's enough to turn on the Timer Exit ' If one is active, it's enough to turn on the Timer
End If End If
Next Next
If IsAnySQLiteLoggingEnabled Then If IsAnySQLiteLoggingEnabled Then
timerLogs.Enabled = True timerLogs.Enabled = True
If logger Then Log("Main.AppStart: Log cleanup timer ACTIVATED (at least one DB requires logs).") If logger Then Log("Main.AppStart: Log cleanup timer ACTIVATED (at least one DB requires logs).")
@@ -385,140 +370,75 @@ End Sub
' --- Subroutine to initialize the local user database (SQLite) --- ' --- Subroutine to initialize the local user database (SQLite) ---
Sub InitializeSQLiteDatabase Sub InitializeSQLiteDatabase
Dim dbFileName As String = "users.db"
' Check if the database file already exists Private dbFileName As String = "users.db"
If File.Exists(File.DirApp, dbFileName) = False Then Private dbDirName As String = GlobalParameters.WorkingDirectory
' --- Create a new database ---
Log("Creating new user database: " & dbFileName) ' --- Configuration for SQL_Logs based on LOG_DB_MODE ---
SQL1.InitializeSQLite(File.DirApp, dbFileName, True) Private logDirName As String = dbDirName
' Create 'users' table Private logFileName As String = dbFileName
Dim createUserTable As String = "CREATE TABLE users (username TEXT PRIMARY KEY, password_hash TEXT NOT NULL)" Private isInMemoryMode As Boolean = (LOG_DB_MODE = "MEMORY")
SQL1.ExecNonQuery(createUserTable)
If isInMemoryMode Then
' For in-memory databases, use the special filename ":memory:" and empty directory.
logDirName = ""
logFileName = ":memory:"
If logger Then Log("NOTICE: SQL_Logs initialized as IN-MEMORY database (data is non-persistent).")
Else
If logger Then Log($"NOTICE: SQL_Logs initialized as DISK database: ${dbFileName}"$)
End If
' Create 'query_logs' table ' Initialize SQL_Auth (always points to the disk file for user persistence).
If logger Then Log("Creating 'query_logs' table with performance columns.") SQL_Auth.InitializeSQLite(dbDirName, dbFileName, True)
Dim createQueryLogsTable As String = "CREATE TABLE query_logs (id INTEGER PRIMARY KEY AUTOINCREMENT, query_name TEXT, duration_ms INTEGER, timestamp INTEGER, db_key TEXT, client_ip TEXT, busy_connections INTEGER, handler_active_requests INTEGER)"
SQL1.ExecNonQuery(createQueryLogsTable) ' Initialize SQL_Logs (points to disk file or :memory:)
SQL_Logs.InitializeSQLite(logDirName, logFileName, True)
' Set PRAGMA for better performance (Write-Ahead Logging) ' Check if schema creation/migration is necessary.
SQL1.ExecNonQuery("PRAGMA journal_mode=WAL;") ' This is true if the disk file is brand new OR if we are running in memory mode.
SQL1.ExecNonQuery("PRAGMA synchronous=NORMAL;") Private isNewDbFile As Boolean = File.Exists(dbDirName, dbFileName) = False
' Insert default user If isNewDbFile Or isInMemoryMode Then
Dim defaultUser As String = "admin"
Dim defaultPass As String = "admin" If logger Then Log("Schema creation required (New DB file or In-Memory mode).")
Dim hashedPass As String = bc.hashpw(defaultPass, bc.gensalt)
SQL1.ExecNonQuery2("INSERT INTO users (username, password_hash) VALUES (?, ?)", Array As Object(defaultUser, hashedPass)) ' 1. TABLE CREATION (Done via SQL_Logs instance, as it handles the schema)
Log($"Default user created -> user: ${defaultUser}, pass: ${defaultPass}"$) SQL_Logs.ExecNonQuery("CREATE TABLE users (username TEXT PRIMARY KEY, password_hash TEXT, last_login_timestamp INTEGER, is_admin INTEGER DEFAULT 0)")
SQL_Logs.ExecNonQuery("CREATE TABLE query_logs (query_name TEXT, duration_ms INTEGER, timestamp INTEGER, db_key TEXT, client_ip TEXT, busy_connections INTEGER, handler_active_requests INTEGER, timestamp_text_local TEXT)")
' Create 'errores' (errors) table SQL_Logs.ExecNonQuery("CREATE TABLE errores (timestamp INTEGER, type TEXT, source TEXT, message TEXT, db_key TEXT, command_name TEXT, client_ip TEXT)")
Log("Creating 'errores' table for event logging.")
Dim createErrorsTable As String = "CREATE TABLE errores (id INTEGER PRIMARY KEY AUTOINCREMENT, timestamp INTEGER, type TEXT, source TEXT, message TEXT, db_key TEXT, command_name TEXT, client_ip TEXT)" ' 2. INDEX CREATION (Done via SQL_Logs instance)
SQL1.ExecNonQuery(createErrorsTable) SQL_Logs.ExecNonQuery("CREATE INDEX idx_query_timestamp ON query_logs(timestamp)")
SQL_Logs.ExecNonQuery("CREATE INDEX idx_query_duration ON query_logs(duration_ms)")
If logger Then Log("Creating performance indexes on log tables.") SQL_Logs.ExecNonQuery("CREATE INDEX idx_query_dbkey ON query_logs(db_key)") ' --- NEW INDEX: CRITICAL FOR MULTI-DB REPORTS
SQL_Logs.ExecNonQuery("CREATE INDEX idx_error_timestamp ON errores(timestamp)")
' Index on timestamp for fast cleanup (DELETE/ORDER BY) in query_logs
SQL1.ExecNonQuery("CREATE INDEX idx_query_timestamp ON query_logs(timestamp)") ' 3. PRAGMAS (Applied to both to ensure consistency in WAL mode)
SQL_Logs.ExecNonQuery("PRAGMA journal_mode=WAL")
' Index on duration_ms for the 'slowqueries' query (ORDER BY) SQL_Logs.ExecNonQuery("PRAGMA synchronous=NORMAL")
SQL1.ExecNonQuery("CREATE INDEX idx_query_duration ON query_logs(duration_ms)") SQL_Auth.ExecNonQuery("PRAGMA journal_mode=WAL")
SQL_Auth.ExecNonQuery("PRAGMA synchronous=NORMAL")
' Index on timestamp for fast cleanup of the errors table
SQL1.ExecNonQuery("CREATE INDEX idx_error_timestamp ON errores(timestamp)")
Else Else
' --- Load existing database --- ' Load existing database (DISK Mode)
SQL1.InitializeSQLite(File.DirApp, dbFileName, True) If logger Then Log("Existing users.db found. Applying PRAGMAS and checking migrations.")
Log("User database loaded.")
' Ensure WAL mode is set on existing DBs
SQL1.ExecNonQuery("PRAGMA journal_mode=WAL;")
SQL1.ExecNonQuery("PRAGMA synchronous=NORMAL;")
' >>> START: Migration logic (ALTER TABLE) if the DB already existed <<< ' Ensure PRAGMAS are set on both connections
If logger Then Log("Verifying and migrating 'query_logs' table if necessary.") SQL_Logs.ExecNonQuery("PRAGMA journal_mode=WAL")
SQL_Logs.ExecNonQuery("PRAGMA synchronous=NORMAL")
' Check if 'query_logs' table exists SQL_Auth.ExecNonQuery("PRAGMA journal_mode=WAL")
If SQL1.ExecQuerySingleResult("SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs'") = Null Then SQL_Auth.ExecNonQuery("PRAGMA synchronous=NORMAL")
If logger Then Log("'query_logs' table not found, creating it with performance columns.")
Dim createQueryLogsTable As String = "CREATE TABLE query_logs (id INTEGER PRIMARY KEY AUTOINCREMENT, query_name TEXT, duration_ms INTEGER, timestamp INTEGER, db_key TEXT, client_ip TEXT, busy_connections INTEGER, handler_active_requests INTEGER)"
SQL1.ExecNonQuery(createQueryLogsTable)
Else
' If the query_logs table already exists, check and add missing columns
Dim columnExists As Boolean
Dim rs As ResultSet
' --- VERIFY AND ADD busy_connections ---
columnExists = False
rs = SQL1.ExecQuery("PRAGMA table_info(query_logs)")
Do While rs.NextRow
If rs.GetString("name").EqualsIgnoreCase("busy_connections") Then
columnExists = True
Exit ' Column already exists, exit loop
End If
Loop
rs.Close
If columnExists = False Then
If logger Then Log("Adding column 'busy_connections' to query_logs.")
SQL1.ExecNonQuery("ALTER TABLE query_logs ADD COLUMN busy_connections INTEGER DEFAULT 0")
End If
' --- VERIFY AND ADD handler_active_requests ---
columnExists = False
rs = SQL1.ExecQuery("PRAGMA table_info(query_logs)")
Do While rs.NextRow
If rs.GetString("name").EqualsIgnoreCase("handler_active_requests") Then
columnExists = True
Exit ' Column already exists, exit loop
End If
Loop
rs.Close
If columnExists = False Then
If logger Then Log("Adding column 'handler_active_requests' to query_logs.")
SQL1.ExecNonQuery("ALTER TABLE query_logs ADD COLUMN handler_active_requests INTEGER DEFAULT 0")
End If
' --- VERIFY AND ADD timestamp_text_local ---
columnExists = False
rs = SQL1.ExecQuery("PRAGMA table_info(query_logs)")
Do While rs.NextRow
If rs.GetString("name").EqualsIgnoreCase("timestamp_text_local") Then
columnExists = True
Exit ' Column already exists, exit loop
End If
Loop
rs.Close
If columnExists = False Then
If logger Then Log("Adding column 'timestamp_text_local' to query_logs.")
' Use 'TEXT' to store the formatted date/time string.
SQL1.ExecNonQuery("ALTER TABLE query_logs ADD COLUMN timestamp_text_local TEXT")
End If
' >>> START: Migration logic for 'errores' if DB already existed <<<
If logger Then Log("Verifying and migrating 'errores' table if necessary.")
If SQL1.ExecQuerySingleResult("SELECT name FROM sqlite_master WHERE type='table' AND name='errores'") = Null Then
If logger Then Log("'errores' table not found, creating it.")
Dim createErrorsTable As String = "CREATE TABLE errores (id INTEGER PRIMARY KEY AUTOINCREMENT, timestamp INTEGER, type TEXT, source TEXT, message TEXT, db_key TEXT, command_name TEXT, client_ip TEXT)"
SQL1.ExecNonQuery(createErrorsTable)
Else
If logger Then Log("'errores' table already exists.")
End If
' >>> END: Migration logic for 'errores' <<<
' >>> Migration Logic (INDEX VERIFICATION) <<<
' Migration check must run on SQL_Logs
' --- VERIFY AND ADD idx_query_dbkey INDEX ---
If SQL_Logs.ExecQuerySingleResult($"SELECT name FROM sqlite_master WHERE type='index' AND name='idx_query_dbkey'"$) = Null Then
If logger Then Log("Adding index 'idx_query_dbkey' to query_logs.")
SQL_Logs.ExecNonQuery("CREATE INDEX idx_query_dbkey ON query_logs(db_key)")
End If End If
' >>> END: Migration logic (ALTER TABLE) <<<
' (Migration logic for other assumed columns/tables should use SQL_Logs)
End If End If
End Sub End Sub
@@ -606,61 +526,55 @@ Public Sub WriteQueryLogsBatch
logsToWrite.Initialize ' 1. Initialize the local list (CRITICAL) logsToWrite.Initialize ' 1. Initialize the local list (CRITICAL)
' === STEP 1: Atomic Cache Swap (Protected by ReentrantLock) === ' === STEP 1: Atomic Cache Swap (Protected by ReentrantLock) ===
LogCacheLock.RunMethod("lock", Null) LogCacheLock.RunMethod("lock", Null)
If QueryLogCache.Size = 0 Then If QueryLogCache.Size = 0 Then
' Cache is empty, release lock and return ' Cache is empty, release lock and return
LogCacheLock.RunMethod("unlock", Null) LogCacheLock.RunMethod("unlock", Null)
Return Return
End If End If
' *** CRITICAL FIX: Copy content (AddAll) instead of reference. *** ' *** CRITICAL FIX: Copy content (AddAll) instead of reference. ***
logsToWrite.AddAll(QueryLogCache) logsToWrite.AddAll(QueryLogCache)
Dim batchSize As Int = logsToWrite.Size Dim batchSize As Int = logsToWrite.Size
' Clear the global cache. logsToWrite now holds the copy of the items. ' Clear the global cache. logsToWrite now holds the copy of the items.
QueryLogCache.Initialize QueryLogCache.Initialize
LogCacheLock.RunMethod("unlock", Null) LogCacheLock.RunMethod("unlock", Null)
' Check if text logging is enabled for any of these logs ' Check if text logging is enabled for any of these logs
If logsToWrite.Size > 0 Then If logsToWrite.Size > 0 Then
' Call the text archiving sub on a separate worker thread. ' Call the text archiving sub on a separate worker thread.
' This is NON-BLOCKING for the current thread, which will proceed to the SQLite transaction. ' This is NON-BLOCKING for the current thread, which will proceed to the SQLite transaction.
CallSubDelayed2(Me, "ArchiveQueryLogsToDailyFile", logsToWrite) CallSubDelayed2(Me, "ArchiveQueryLogsToDailyFile", logsToWrite)
End If End If
' === STEP 2: Transactional Write to SQLite ===
' === STEP 2: Transactional Write to SQLite ===
Try Try
' 1. Begin the transaction: Everything that follows is a single disk operation. ' 1. Begin the transaction on the dedicated LOGS instance.
SQL1.BeginTransaction SQL_Logs.BeginTransaction
For Each logEntry As Map In logsToWrite For Each logEntry As Map In logsToWrite
' Insert the log entry ' Insert the log entry
SQL1.ExecNonQuery2("INSERT INTO query_logs (query_name, duration_ms, timestamp, db_key, client_ip, busy_connections, handler_active_requests, timestamp_text_local) VALUES (?, ?, ?, ?, ?, ?, ?, ?)", _ SQL_Logs.ExecNonQuery2("INSERT INTO query_logs (query_name, duration_ms, timestamp, db_key, client_ip, busy_connections, handler_active_requests, timestamp_text_local) VALUES (?, ?, ?, ?, ?, ?, ?, ?)", _
Array As Object(logEntry.Get("query_name"), logEntry.Get("duration_ms"), logEntry.Get("timestamp"), logEntry.Get("db_key"), _ Array As Object(logEntry.Get("query_name"), logEntry.Get("duration_ms"), logEntry.Get("timestamp"), logEntry.Get("db_key"), _
logEntry.Get("client_ip"), logEntry.Get("busy_connections"), logEntry.Get("handler_active_requests"), _ logEntry.Get("client_ip"), logEntry.Get("busy_connections"), logEntry.Get("handler_active_requests"), _
logEntry.Get("timestamp_text_local"))) logEntry.Get("timestamp_text_local")))
Next Next
' 2. Finalize the transaction: Efficient write to disk. ' 2. Finalize the transaction: Efficient write to disk.
SQL1.TransactionSuccessful SQL_Logs.TransactionSuccessful
If logger Then Log($"[LOG BATCH] Batch of ${batchSize} performance logs written successfully."$) If logger Then Log($"[LOG BATCH] Batch of ${batchSize} performance logs written successfully."$)
Catch Catch
' If it fails, undo all logs in this batch and log the failure. ' If it fails, undo all logs in this batch and log the failure.
SQL1.Rollback SQL_Logs.Rollback
Dim ErrorMsg As String = "CRITICAL ERROR: Failed to write performance log batch to SQLite: " & LastException.Message Dim ErrorMsg As String = "CRITICAL ERROR: Failed to write performance log batch to SQLite: " & LastException.Message
Log(ErrorMsg) Log(ErrorMsg)
' Use LogServerError so the failure is recorded in the 'errores' table (if logging is enabled) ' Use LogServerError so the failure is recorded in the 'errores' table (if logging is enabled)
LogServerError("ERROR", "Main.WriteQueryLogsBatch", ErrorMsg, Null, "log_batch_write_performance", Null) LogServerError("ERROR", "Main.WriteQueryLogsBatch", ErrorMsg, Null, "log_batch_write_performance", Null)
End Try End Try
End Sub End Sub
' --- Event subroutine for the 'timerLogs' Timer. --- ' --- Event subroutine for the 'timerLogs' Timer. ---
@@ -674,7 +588,7 @@ Sub TimerLogs_Tick
WriteErrorLogsBatch WriteErrorLogsBatch
' 3. Clean up and VACUUM (this sub also checks IsAnySQLiteLoggingEnabled) ' 3. Clean up and VACUUM (this sub also checks IsAnySQLiteLoggingEnabled)
borraArribaDe30000Logs borraArribaDe10000Logs
Catch Catch
Dim ErrorMsg As String = "ERROR in TimerLogs_Tick while trying to clear logs: " & LastException.Message Dim ErrorMsg As String = "ERROR in TimerLogs_Tick while trying to clear logs: " & LastException.Message
@@ -685,114 +599,115 @@ End Sub
' Writes the cached error logs to the SQLite DB in a single transaction ' Writes the cached error logs to the SQLite DB in a single transaction
Public Sub WriteErrorLogsBatch Public Sub WriteErrorLogsBatch
' List to store error logs copied from the cache
Dim logsToWrite As List Dim logsToWrite As List
logsToWrite.Initialize logsToWrite.Initialize
' === STEP 1: Atomic Cache Swap (Protected by ReentrantLock) === ' Lock LogCacheLock to guarantee atomicity of copy and cleanup.
' Bloqueamos el LogCacheLock para garantizar la atomicidad de la copia y limpieza.
LogCacheLock.RunMethod("lock", Null) LogCacheLock.RunMethod("lock", Null)
If ErrorLogCache.Size = 0 Then If ErrorLogCache.Size = 0 Then
' La caché está vacía, liberamos el lock inmediatamente y salimos. ' Cache is empty, release the lock immediately and exit.
LogCacheLock.RunMethod("unlock", Null) LogCacheLock.RunMethod("unlock", Null)
Return Return
End If End If
' *** Copiar el contenido de la caché global de forma atómica. *** ' *** Atomically copy global cache content. ***
logsToWrite.AddAll(ErrorLogCache) logsToWrite.AddAll(ErrorLogCache)
' Usar el tamaño de la lista copiada para el procesamiento.
Dim batchSize As Int = logsToWrite.Size Dim batchSize As Int = logsToWrite.Size
' Log(logsToWrite)
' Clean the global cache. logsToWrite is now an independent and populated list.
' Limpiar la caché global. logsToWrite es ahora una lista independiente y poblada.
ErrorLogCache.Initialize ErrorLogCache.Initialize
LogCacheLock.RunMethod("unlock", Null) ' Release the lock.
LogCacheLock.RunMethod("unlock", Null) ' Liberar el lock.
If logger Then Log($"[LOG BATCH] Starting transactional write of ${batchSize} ERROR logs to SQLite. Logs copied: ${batchSize}"$) If logger Then Log($"[LOG BATCH] Starting transactional write of ${batchSize} ERROR logs to SQLite. Logs copied: ${batchSize}"$)
' === La corrección de Lógica ocurre aquí: La llamada a ArchiveErrorLogsToDailyFile ' === STEP 1: Archive to daily CSV file (if enabled) ===
' y el proceso transaccional ocurren AHORA, después de asegurar que logsToWrite
' tiene contenido y que el lock fue liberado. ===
' 1. (Opcional, si el logging de texto CSV está habilitado)
If batchSize > 0 Then If batchSize > 0 Then
' Delegar a una nueva subrutina para manejar la I/O de disco CSV (CallSubDelayed2) ' Delegate to a new subroutine to handle CSV disk I/O (CallSubDelayed2)
CallSubDelayed2(Me, "ArchiveErrorLogsToDailyFile", logsToWrite) CallSubDelayed2(Me, "ArchiveErrorLogsToDailyFile", logsToWrite)
End If End If
' === STEP 2: Escritura Transaccional a SQLite (Usa logsToWrite) === ' === STEP 2: Transactional Write to SQLite (Uses logsToWrite) ===
If batchSize = 0 Then If batchSize = 0 Then
' Este caso no debería ocurrir con la lógica anterior, pero es un chequeo de seguridad.
Log("WARNING: Failed to copy list. logsToWrite is empty. Aborting write.") Log("WARNING: Failed to copy list. logsToWrite is empty. Aborting write.")
Return Return
End If End If
Try Try
' 1. Iniciar la transacción. ' 1. Start transaction on the dedicated LOGS instance.
SQL1.BeginTransaction SQL_Logs.BeginTransaction
For Each logEntry As Map In logsToWrite For Each logEntry As Map In logsToWrite
' Insertar la entrada de log ' Insert the log entry
SQL1.ExecNonQuery2("INSERT INTO errores (timestamp, type, source, message, db_key, command_name, client_ip) VALUES (?, ?, ?, ?, ?, ?, ?)", _ SQL_Logs.ExecNonQuery2("INSERT INTO errores (timestamp, type, source, message, db_key, command_name, client_ip) VALUES (?, ?, ?, ?, ?, ?, ?)", _
Array As Object(logEntry.Get("timestamp"), logEntry.Get("type"), logEntry.Get("source"), logEntry.Get("message"), _ Array As Object(logEntry.Get("timestamp"), logEntry.Get("type"), logEntry.Get("source"), logEntry.Get("message"), _
logEntry.Get("db_key"), logEntry.Get("command_name"), logEntry.Get("client_ip"))) logEntry.Get("db_key"), logEntry.Get("command_name"), logEntry.Get("client_ip")))
Next Next
' 2. Confirmar la transacción. ' 2. Commit the transaction.
SQL1.TransactionSuccessful SQL_Logs.TransactionSuccessful
If logger Then Log($"[LOG BATCH] Batch of ${logsToWrite.Size} ERROR logs written successfully."$) If logger Then Log($"[LOG BATCH] Batch of ${logsToWrite.Size} ERROR logs written successfully."$)
Catch Catch
' 3. Rollback si falla. ' 3. Rollback if failed.
SQL1.Rollback SQL_Logs.Rollback
Dim ErrorMsg As String = "CRITICAL ERROR: Failed to write ERROR log batch to SQLite: " & LastException.Message Dim ErrorMsg As String = "CRITICAL ERROR: Failed to write ERROR log batch to SQLite: " & LastException.Message
Log(ErrorMsg) Log(ErrorMsg)
End Try End Try
End Sub End Sub
' Deletes the oldest records from 'query_logs' table and runs VACUUM. ' Deletes the oldest records from 'query_logs' table and runs VACUUM.
Sub borraArribaDe30000Logs 'ignore Sub borraArribaDe10000Logs 'ignore
If IsAnySQLiteLoggingEnabled Then ' Only run if at least one DB requires logs.
' 1. Cleanup of Performance Logs (query_logs)
If logger Then Log("Trimming 'query_logs' table, limit of 30,000 records.")
Dim fechaCorte As Long ' (cutoff date/timestamp)
' First, try to find the timestamp of the 30,001st record.
Try ' OFFSET 30000 skips the 30,000 most recent.
fechaCorte = SQL1.ExecQuerySingleResult($"SELECT timestamp FROM query_logs ORDER BY timestamp DESC LIMIT 1 OFFSET 30000"$)
Catch ' If the table has fewer than 30,000 records, the result is NULL or throws an exception.
fechaCorte = 0 ' Force to 0 so it doesn't delete anything.
End Try
' If a cutoff time was found (i.e., there are more than 30,000 records)...
If fechaCorte > 0 Then ' Execute the simple DELETE, which is very fast using the idx_query_timestamp index.
SQL1.ExecNonQuery2("DELETE FROM query_logs WHERE timestamp < ?", Array As Object(fechaCorte))
End If
Private Const LOG_LIMIT_PERFORMANCE As Int = 10000 ' New limit for performance logs
Private Const LOG_LIMIT_ERRORS As Int = 10000 ' Limit for error logs (retained 15,000)
If IsAnySQLiteLoggingEnabled Then ' Only run if at least one DB requires logs.
' 1. Cleanup of Performance Logs (query_logs)
If logger Then Log($"Trimming 'query_logs' table, limit of ${LOG_LIMIT_PERFORMANCE} records."$)
Dim fechaCorte As Long ' (cutoff date/timestamp)
' Find the timestamp of the (LOG_LIMIT_PERFORMANCE + 1)st record using SQL_Logs
Try ' OFFSET skips the most recent records.
fechaCorte = SQL_Logs.ExecQuerySingleResult($"SELECT timestamp FROM query_logs ORDER BY timestamp DESC LIMIT 1 OFFSET ${LOG_LIMIT_PERFORMANCE}"$)
Catch ' If the table has fewer records than the limit.
fechaCorte = 0
End Try
If fechaCorte > 0 Then ' Execute DELETE on SQL_Logs
SQL_Logs.ExecNonQuery2("DELETE FROM query_logs WHERE timestamp < ?", Array As Object(fechaCorte))
End If
' 2. Cleanup of Error Logs (errores) ' 2. Cleanup of Error Logs (errores)
Dim fechaCorteError As Long Dim fechaCorteError As Long
Try ' OFFSET 15000 skips the 15,000 most recent. Try ' OFFSET LOG_LIMIT_ERRORS skips the most recent.
fechaCorteError = SQL1.ExecQuerySingleResult($"SELECT timestamp FROM errores ORDER BY timestamp DESC LIMIT 1 OFFSET 15000"$) fechaCorteError = SQL_Logs.ExecQuerySingleResult($"SELECT timestamp FROM errores ORDER BY timestamp DESC LIMIT 1 OFFSET ${LOG_LIMIT_ERRORS}"$)
Catch ' If the table has fewer than 15,000 records, result is NULL. Catch ' If the table has fewer than 15,000 records.
fechaCorteError = 0 fechaCorteError = 0
End Try End Try
' If a cutoff time was found... ' If a cutoff time was found...
If fechaCorteError > 0 Then If fechaCorteError > 0 Then
SQL1.ExecNonQuery2("DELETE FROM errores WHERE timestamp < ?", Array As Object(fechaCorteError)) SQL_Logs.ExecNonQuery2("DELETE FROM errores WHERE timestamp < ?", Array As Object(fechaCorteError))
End If End If
' 3. Control and Conditional Execution of VACUUM ' 3. Control and Conditional Execution of VACUUM
TimerTickCount = TimerTickCount + 1 TimerTickCount = TimerTickCount + 1
If TimerTickCount >= VACUUM_CYCLES Then If TimerTickCount >= VACUUM_CYCLES Then
If logger Then Log("EXECUTING VACUUM (24-hour cycle completed).") If logger Then Log("EXECUTING VACUUM (24-hour cycle completed).")
SQL1.ExecNonQuery("vacuum;") ' Execute VACUUM. SQL_Logs.ExecNonQuery("vacuum;") ' Execute VACUUM on SQL_Logs.
TimerTickCount = 0 ' Reset the counter. TimerTickCount = 0 ' Reset the counter.
Else Else
' Show how many cycles are left, only if logger is active.
If logger Then Log($"VACUUM skipped. ${VACUUM_CYCLES - TimerTickCount} cycles remaining until daily execution."$) If logger Then Log($"VACUUM skipped. ${VACUUM_CYCLES - TimerTickCount} cycles remaining until daily execution."$)
End If End If
Else Else
' If IsAnySQLiteLoggingEnabled is False, the Timer should not be active.
If logger Then Log("NOTICE: Log cleanup task skipped. Global SQLite logging is disabled.") If logger Then Log("NOTICE: Log cleanup task skipped. Global SQLite logging is disabled.")
End If End If
End Sub End Sub

15
jRDC_Multi.b4j.meta
View File

@@ -8,7 +8,6 @@ ModuleBookmarks14=
ModuleBookmarks15= ModuleBookmarks15=
ModuleBookmarks16= ModuleBookmarks16=
ModuleBookmarks17= ModuleBookmarks17=
ModuleBookmarks18=
ModuleBookmarks2= ModuleBookmarks2=
ModuleBookmarks3= ModuleBookmarks3=
ModuleBookmarks4= ModuleBookmarks4=
@@ -27,7 +26,6 @@ ModuleBreakpoints14=
ModuleBreakpoints15= ModuleBreakpoints15=
ModuleBreakpoints16= ModuleBreakpoints16=
ModuleBreakpoints17= ModuleBreakpoints17=
ModuleBreakpoints18=
ModuleBreakpoints2= ModuleBreakpoints2=
ModuleBreakpoints3= ModuleBreakpoints3=
ModuleBreakpoints4= ModuleBreakpoints4=
@@ -42,11 +40,10 @@ ModuleClosedNodes10=
ModuleClosedNodes11= ModuleClosedNodes11=
ModuleClosedNodes12= ModuleClosedNodes12=
ModuleClosedNodes13= ModuleClosedNodes13=
ModuleClosedNodes14= ModuleClosedNodes14=2,3,4,6,7
ModuleClosedNodes15= ModuleClosedNodes15=5,6
ModuleClosedNodes16=5,6 ModuleClosedNodes16=2,3
ModuleClosedNodes17=2,3 ModuleClosedNodes17=
ModuleClosedNodes18=
ModuleClosedNodes2= ModuleClosedNodes2=
ModuleClosedNodes3= ModuleClosedNodes3=
ModuleClosedNodes4= ModuleClosedNodes4=
@@ -55,6 +52,6 @@ ModuleClosedNodes6=
ModuleClosedNodes7= ModuleClosedNodes7=
ModuleClosedNodes8= ModuleClosedNodes8=
ModuleClosedNodes9= ModuleClosedNodes9=
NavigationStack=DBHandlerB4X,Handle,103,6,DBHandlerB4X,CleanupAndLog,221,0,Main,ArchiveQueryLogsToDailyFile,839,0,RDCConnector,Class_Globals,6,0,DBHandlerJSON,Handle,219,0,Main,AppStart,255,6,Main,LogQueryPerformance,510,0,Main,WriteErrorLogsBatch,654,6,Main,LogServerError,539,6,Main,ArchiveErrorLogsToDailyFile,869,6 NavigationStack=Main,WriteErrorLogsBatch,587,0,DoLoginHandler,Handle,32,0,ChangePassHandler,Handle,9,0,Main,WriteQueryLogsBatch,461,0,RDCConnector,Class_Globals,4,0,Main,Process_Globals,60,0,Main,InitializeSQLiteDatabase,370,0,Main,borraArribaDe10000Logs,612,0,Main,TimerLogs_Tick,532,0,Manager,Handle,79,0,Cambios,Process_Globals,19,0
SelectedBuild=0 SelectedBuild=0
VisibleModules=4,5,15,1,12,9,3,13 VisibleModules=3,4,14,1,11,8,12,5,2