mirror of
https://github.com/KeymonSoft/jRDC-MultiDB-Hikari.git
synced 2026-04-17 12:56:23 +00:00
- 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. - 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
10
Cambios.bas
10
Cambios.bas
@@ -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
|
||||
' 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
|
||||
' - 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.
|
||||
|
||||
@@ -14,7 +14,7 @@ Public Sub Initialize
|
||||
End Sub
|
||||
|
||||
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
|
||||
resp.SendRedirect("/login")
|
||||
Return
|
||||
@@ -26,27 +26,26 @@ Public Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
Dim confirmPass As String = req.GetParameter("confirm_password")
|
||||
|
||||
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
|
||||
End If
|
||||
|
||||
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)
|
||||
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
|
||||
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)
|
||||
Main.SQL1.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>")
|
||||
|
||||
Main.SQL_Auth.ExecNonQuery2("UPDATE users SET password_hash = ? WHERE username = ?", Array As Object(newHashedPass, currentUser))
|
||||
|
||||
resp.Write("Contraseña cambiada exitosamente.")
|
||||
Catch
|
||||
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 Sub
|
||||
@@ -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
|
||||
@@ -4,139 +4,134 @@ ModulesStructureVersion=1
|
||||
Type=Class
|
||||
Version=10.3
|
||||
@EndOfDesignText@
|
||||
' Módulo de clase: DBHandlerJSON
|
||||
' Este handler se encarga de procesar las peticiones HTTP que esperan o envían datos en formato JSON.
|
||||
' Es ideal para clientes web (JavaScript, axios, etc.) o servicios que interactúan con el servidor
|
||||
' mediante un API RESTful. Soporta tanto GET con JSON en un parámetro 'j' como POST con JSON
|
||||
' en el cuerpo de la petición.
|
||||
' Class module: DBHandlerJSON
|
||||
' This handler is responsible for processing HTTP requests that expect or send data in JSON format.
|
||||
' It is ideal for web clients (JavaScript, axios, etc.) or services that interact with the server
|
||||
' via a RESTful API. It supports both GET with JSON in a 'j' parameter and POST with JSON
|
||||
' in the request body.
|
||||
|
||||
Sub Class_Globals
|
||||
' Declara una variable privada para mantener una instancia del conector RDC.
|
||||
' Este objeto maneja la comunicación con la base de datos específica de la petición.
|
||||
' Declares a private variable to hold an instance of the RDC connector.
|
||||
' This object manages communication with the request's specific database.
|
||||
Private Connector As RDCConnector
|
||||
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
|
||||
' 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
|
||||
|
||||
' 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)
|
||||
' --- Headers CORS (Cross-Origin Resource Sharing) ---
|
||||
' Estos encabezados son esenciales para permitir que aplicaciones web (clientes)
|
||||
' alojadas en diferentes dominios puedan comunicarse con este servidor.
|
||||
resp.SetHeader("Access-Control-Allow-Origin", "*") ' Permite peticiones desde cualquier origen.
|
||||
resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") ' Métodos HTTP permitidos.
|
||||
resp.SetHeader("Access-Control-Allow-Headers", "Content-Type") ' Encabezados permitidos.
|
||||
' CORS (Cross-Origin Resource Sharing) Headers
|
||||
' These headers are essential to allow web applications (clients)
|
||||
' hosted on different domains to communicate with this server.
|
||||
resp.SetHeader("Access-Control-Allow-Origin", "*") ' Allows requests from any origin.
|
||||
resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") ' Allowed HTTP methods.
|
||||
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
|
||||
Return ' Salimos directamente para estas peticiones.
|
||||
Return ' We exit directly for these requests.
|
||||
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.
|
||||
Dim con As SQL ' La conexión a la BD, se inicializará más tarde.
|
||||
Dim queryNameForLog As String = "unknown_json_command" ' Nombre del comando para el log, con valor por defecto.
|
||||
Dim duration As Long ' La duración total de la petición, calculada antes del log.
|
||||
Dim poolBusyConnectionsForLog As Int = 0 ' Contiene el número de conexiones ocupadas del pool.
|
||||
Dim finalDbKey As String = "DB1" ' Identificador de la base de datos, con valor por defecto "DB1".
|
||||
Dim requestsBeforeDecrement As Int = 0 ' Contador de peticiones activas antes de decrementar, inicializado en 0.
|
||||
' Variable declarations with scope throughout the sub to ensure final cleanup.
|
||||
Dim con As SQL ' The DB connection, will be initialized later.
|
||||
Dim queryNameForLog As String = "unknown_json_command" ' Command name for the log, with a default value.
|
||||
Dim duration As Long ' The total request duration, calculated before logging.
|
||||
Dim poolBusyConnectionsForLog As Int = 0 ' Contains the number of busy connections from the pool.
|
||||
Dim finalDbKey As String = "DB1" ' Database identifier, defaulting to "DB1".
|
||||
Dim requestsBeforeDecrement As Int = 0 ' Active request counter before decrementing, initialized to 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
|
||||
' <<<< 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
|
||||
' 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 bytes() As Byte = Bit.InputStreamToBytes(Is0) ' Lee el cuerpo completo de la petición.
|
||||
jsonString = BytesToString(bytes, 0, bytes.Length, "UTF8") ' Convierte los bytes a una cadena JSON.
|
||||
Is0.Close ' Cierra explícitamente el InputStream para liberar recursos.
|
||||
Dim bytes() As Byte = Bit.InputStreamToBytes(Is0) ' Read the entire request body.
|
||||
jsonString = BytesToString(bytes, 0, bytes.Length, "UTF8") ' Convert bytes to a JSON string.
|
||||
Is0.Close ' Explicitly close the InputStream to free resources.
|
||||
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")
|
||||
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
|
||||
Dim ErrorMsg As String = "Falta el parámetro 'j' en el URL o el cuerpo JSON en la petición."
|
||||
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
|
||||
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
|
||||
Return
|
||||
End If
|
||||
|
||||
Dim parser As JSONParser
|
||||
parser.Initialize(jsonString) ' Inicializa el parser JSON con la cadena recibida.
|
||||
Dim RootMap As Map = parser.NextObject ' Parsea el JSON a un objeto Map.
|
||||
parser.Initialize(jsonString) ' Initialize the JSON parser with the received string.
|
||||
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", "")
|
||||
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
|
||||
paramsList.Initialize ' Si no hay parámetros, inicializa una lista vacía.
|
||||
paramsList.Initialize ' If no parameters, initialize an empty list.
|
||||
End If
|
||||
|
||||
' <<<< ¡CORRECCIÓN CLAVE: RESOLVEMOS finalDbKey del JSON ANTES de usarla para los contadores! >>>>
|
||||
' Esto asegura que el contador y el conector usen la DB correcta.
|
||||
' Resolve finalDbKey from the JSON BEFORE using it for counters.
|
||||
' This ensures the counter and connector use the correct DB.
|
||||
If RootMap.Get("dbx") <> Null Then finalDbKey = RootMap.Get("dbx")
|
||||
' <<<< ¡FIN DE CORRECCIÓN CLAVE! >>>>
|
||||
|
||||
' --- INICIO: Conteo de peticiones activas para esta finalDbKey (Incrementar) ---
|
||||
' Este bloque incrementa un contador global que rastrea cuántas peticiones están
|
||||
' activas para una base de datos específica en un momento dado.
|
||||
' 1. Aseguramos que el valor inicial sea un Int y lo recuperamos como Int (usando .As(Int)).
|
||||
' --- START: Active request count for this finalDbKey (Increment) ---
|
||||
' This block increments a global counter tracking how many requests
|
||||
' are active for a specific database at any given time.
|
||||
' 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)
|
||||
GlobalParameters.ActiveRequestsCountByDB.Put(finalDbKey, currentCountFromMap + 1)
|
||||
' requestsBeforeDecrement es el valor del contador justo después de que esta petición lo incrementa.
|
||||
' Este es el valor que se registrará en la tabla 'query_logs'.
|
||||
' requestsBeforeDecrement is the counter value right after this request increments it.
|
||||
' This is the value that will be recorded in the 'query_logs' table.
|
||||
requestsBeforeDecrement = currentCountFromMap + 1
|
||||
' Los logs de depuración para el incremento del contador pueden ser descomentados para una depuración profunda.
|
||||
' Log($"[DEBUG] Handle Increment (JSON): dbKey=${finalDbKey}, currentCountFromMap=${currentCountFromMap}, requestsBeforeDecrement=${requestsBeforeDecrement}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
|
||||
' --- FIN: Conteo de peticiones activas ---
|
||||
' --- END: Active request count ---
|
||||
|
||||
' Inicializa el Connector con la finalDbKey resuelta.
|
||||
' Initialize the Connector with the resolved 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
|
||||
Dim ErrorMsg As String = "Parámetro 'DB' inválido. El nombre '" & finalDbKey & "' no es válido."
|
||||
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
|
||||
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
|
||||
Return
|
||||
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! >>>>
|
||||
' Este bloque captura el número de conexiones actualmente ocupadas en el pool
|
||||
' *después* de que esta petición ha obtenido la suya.
|
||||
' Capture BUSY_CONNECTIONS IMMEDIATELY AFTER getting the connection.
|
||||
' This block captures the number of connections currently busy in the pool
|
||||
' *after* this request has obtained its own.
|
||||
If Connector.IsInitialized Then
|
||||
Dim poolStats As Map = Connector.GetPoolStats
|
||||
If poolStats.ContainsKey("BusyConnections") Then
|
||||
' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que el valor sea Int! >>>>
|
||||
poolBusyConnectionsForLog = poolStats.Get("BusyConnections").As(Int) ' Capturamos el valor.
|
||||
' Ensure the value is Int!
|
||||
poolBusyConnectionsForLog = poolStats.Get("BusyConnections").As(Int) ' We capture the value.
|
||||
' Log($">>>>>>>>>> ${poolStats.Get("BusyConnections")} "$)
|
||||
End If
|
||||
End If
|
||||
' <<<< ¡FIN DE CAPTURA! >>>>
|
||||
|
||||
Dim cachedStatsJSON As Map = Main.LatestPoolStats.Get(finalDbKey).As(Map)
|
||||
|
||||
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("HandlerActiveRequests", requestsBeforeDecrement)
|
||||
If poolStats.ContainsKey("TotalConnections") Then
|
||||
@@ -145,167 +140,161 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
If poolStats.ContainsKey("IdleConnections") Then
|
||||
cachedStatsJSON.Put("IdleConnections", poolStats.Get("IdleConnections"))
|
||||
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)
|
||||
' Log(Main.LatestPoolStats)
|
||||
End If
|
||||
|
||||
' 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)
|
||||
|
||||
' 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
|
||||
Dim errorMessage As String = $"El comando '${queryNameForLog}' no fue encontrado en el config.properties de '${finalDbKey}'."$
|
||||
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)
|
||||
duration = DateTime.Now - start
|
||||
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
|
||||
Return
|
||||
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
|
||||
' --- INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
|
||||
' --- START CENTRALIZED PARAMETER VALIDATION ---
|
||||
Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryNameForLog, finalDbKey, sqlCommand, paramsList, Connector.IsParameterToleranceEnabled)
|
||||
|
||||
If validationResult.Success = False Then
|
||||
SendErrorResponse(resp, 400, validationResult.ErrorMessage)
|
||||
duration = DateTime.Now - start
|
||||
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
|
||||
Return ' Salida temprana.
|
||||
Return ' Early exit.
|
||||
End If
|
||||
|
||||
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)
|
||||
' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
|
||||
' --- END CENTRALIZED PARAMETER VALIDATION ---
|
||||
|
||||
Dim ResultList As List
|
||||
ResultList.Initialize ' Lista para almacenar los resultados de la consulta.
|
||||
Dim jrs As JavaObject = rs ' Objeto Java subyacente del ResultSet para metadatos.
|
||||
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) ' Metadatos del ResultSet.
|
||||
Dim cols As Int = rsmd.RunMethod("getColumnCount", Null) ' Número de columnas.
|
||||
ResultList.Initialize ' List to store query results.
|
||||
Dim jrs As JavaObject = rs ' Underlying Java object of the ResultSet for metadata.
|
||||
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) ' ResultSet metadata.
|
||||
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
|
||||
RowMap.Initialize ' Mapa para almacenar los datos de la fila actual.
|
||||
For i = 1 To cols ' Itera sobre cada columna.
|
||||
Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i)) ' Nombre de la columna.
|
||||
Dim value As Object = jrs.RunMethod("getObject", Array(i)) ' Valor de la columna.
|
||||
RowMap.Put(ColumnName, value) ' Añade la columna y su valor al mapa de la fila.
|
||||
RowMap.Initialize ' Map to store the current row's data.
|
||||
For i = 1 To cols ' Iterate over each column.
|
||||
Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i)) ' Column name.
|
||||
Dim value As Object = jrs.RunMethod("getObject", Array(i)) ' Column value.
|
||||
RowMap.Put(ColumnName, value) ' Add the column and its value to the row map.
|
||||
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
|
||||
rs.Close ' Cierra el ResultSet.
|
||||
SendSuccessResponse(resp, CreateMap("result": ResultList)) ' Envía la respuesta JSON de éxito.
|
||||
rs.Close ' Close the ResultSet.
|
||||
SendSuccessResponse(resp, CreateMap("result": ResultList)) ' Send the success JSON response.
|
||||
|
||||
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)
|
||||
|
||||
If validationResult.Success = False Then
|
||||
SendErrorResponse(resp, 400, validationResult.ErrorMessage)
|
||||
duration = DateTime.Now - start
|
||||
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
|
||||
Return ' Salida temprana.
|
||||
Return ' Early exit.
|
||||
End If
|
||||
Dim affectedCount As Int = 1 ' Asumimos éxito (1) si ExecNonQuery2 no lanza una excepción.
|
||||
con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Ejecuta un comando con la lista de parámetros validada.
|
||||
SendSuccessResponse(resp, CreateMap("affectedRows": affectedCount, "message": "Command executed successfully")) ' Envía confirmación de éxito.
|
||||
' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
|
||||
Dim affectedCount As Int = 1 ' Assume success (1) if ExecNonQuery2 doesn't throw an exception.
|
||||
con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Execute a command with the validated parameter list.
|
||||
SendSuccessResponse(resp, CreateMap("affectedRows": affectedCount, "message": "Command executed successfully")) ' Send success confirmation.
|
||||
' --- END CENTRALIZED PARAMETER VALIDATION ---
|
||||
Else
|
||||
Dim ErrorMsg As String = "Parámetro 'exec' inválido. '" & execType & "' no es un valor permitido."
|
||||
SendErrorResponse(resp, 400, ErrorMsg)
|
||||
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log
|
||||
' El flujo continúa hasta la limpieza final si no hay un Return explícito.
|
||||
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress)
|
||||
' Flow continues to final cleanup if there is no explicit Return.
|
||||
End If
|
||||
Catch ' --- CATCH: Maneja errores generales de ejecución o de SQL/JSON ---
|
||||
Log(LastException) ' Registra la excepción completa en el log.
|
||||
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", LastException.Message, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log
|
||||
SendErrorResponse(resp, 500, LastException.Message) ' Envía un error 500 al cliente.
|
||||
queryNameForLog = "error_processing_json" ' Para registrar que hubo un error en el log.
|
||||
End Try ' --- FIN: Bloque Try principal ---
|
||||
Catch ' --- CATCH: Handle general execution or SQL/JSON errors ---
|
||||
Log(LastException) ' Log the full exception.
|
||||
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", LastException.Message, finalDbKey, queryNameForLog, req.RemoteAddress)
|
||||
SendErrorResponse(resp, 500, LastException.Message) ' Send a 500 error to the client.
|
||||
queryNameForLog = "error_processing_json" ' To log that there was an error.
|
||||
End Try ' --- END: Main Try block ---
|
||||
|
||||
' --- Lógica de logging y limpieza final (para rutas de ejecución normal o después de Catch) ---
|
||||
' Este bloque se asegura de que, independientemente de cómo termine la petición (éxito o error),
|
||||
' la duración se calcule y se llamen las subrutinas de limpieza y logging.
|
||||
duration = DateTime.Now - start ' Calcula la duración total de la petición.
|
||||
' Llama a la subrutina centralizada para registrar el rendimiento y limpiar recursos.
|
||||
' --- Final logging and cleanup logic (for normal execution paths or after Catch) ---
|
||||
' This block ensures that, regardless of how the request ends (success or error),
|
||||
' the duration is calculated and the cleanup and logging subs are called.
|
||||
duration = DateTime.Now - start ' Calculate the total request duration.
|
||||
' Call the centralized subroutine to log performance and clean up resources.
|
||||
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
|
||||
End Sub
|
||||
|
||||
' --- NUEVA SUBRUTINA: Centraliza el logging de rendimiento y la limpieza de recursos ---
|
||||
' Esta subrutina es llamada por Handle en todos los puntos de salida, asegurando
|
||||
' que los contadores se decrementen y las conexiones se cierren de forma consistente.
|
||||
' --- Subroutine: Centralizes performance logging and resource cleanup ---
|
||||
' This subroutine is called by Handle at all exit points, ensuring
|
||||
' 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)
|
||||
' Los logs de depuración para CleanupAndLog pueden ser descomentados para una depuración profunda.
|
||||
' 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.
|
||||
' 1. Call the centralized subroutine in Main to log performance to SQLite.
|
||||
Main.LogQueryPerformance(qName, durMs, dbKey, clientIp, handlerReqs, poolBusyConns)
|
||||
|
||||
' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que currentCount sea Int al obtenerlo del mapa! >>>>
|
||||
' 2. Decrementa el contador de peticiones activas para esta dbKey de forma robusta.
|
||||
' 2. Robustly decrement the active request counter for this dbKey.
|
||||
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
|
||||
' Si el contador es positivo, lo decrementamos.
|
||||
' If the counter is positive, decrement it.
|
||||
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, currentCount - 1)
|
||||
Else
|
||||
' Si el contador ya está en 0 o negativo (lo cual no debería ocurrir con la lógica actual,
|
||||
' pero se maneja para robustez), registramos una advertencia y lo aseguramos en 0.
|
||||
' If the counter is already 0 or negative (which shouldn't happen with current logic,
|
||||
' 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."$)
|
||||
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, 0)
|
||||
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
|
||||
End Sub
|
||||
|
||||
' --- Subrutinas de ayuda para respuestas JSON ---
|
||||
' --- Helper subroutines for JSON responses ---
|
||||
|
||||
' Construye y envía una respuesta JSON de éxito.
|
||||
' resp: El objeto ServletResponse para enviar la respuesta.
|
||||
' dataMap: Un mapa que contiene los datos a incluir en la respuesta JSON.
|
||||
' Builds and sends a success JSON response.
|
||||
' resp: The ServletResponse object to send the response.
|
||||
' dataMap: A map containing the data to include in the JSON response.
|
||||
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)
|
||||
|
||||
' Crea un generador de JSON.
|
||||
' Create a JSON generator.
|
||||
Dim jsonGenerator As JSONGenerator
|
||||
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"
|
||||
' 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)
|
||||
End Sub
|
||||
|
||||
' Construye y envía una respuesta JSON de error.
|
||||
' resp: El objeto ServletResponse para enviar la respuesta.
|
||||
' statusCode: El código de estado HTTP (ej. 400 para error del cliente, 500 para error del servidor).
|
||||
' errorMessage: El mensaje de error que se enviará al cliente.
|
||||
' Builds and sends an error JSON response.
|
||||
' resp: The ServletResponse object to send the response.
|
||||
' statusCode: The HTTP status code (e.g., 400 for client error, 500 for server error).
|
||||
' errorMessage: The error message to be sent to the client.
|
||||
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
|
||||
errorMessage = "NUMERO DE PARAMETROS EQUIVOCADO: " & errorMessage
|
||||
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)
|
||||
|
||||
' Genera la cadena JSON a partir del mapa.
|
||||
' Generate the JSON string from the map.
|
||||
Dim jsonGenerator As JSONGenerator
|
||||
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
|
||||
' 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.Write(jsonGenerator.ToString)
|
||||
End Sub
|
||||
End Sub
|
||||
|
||||
@@ -19,18 +19,15 @@ Public Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
Dim p As String = req.GetParameter("password")
|
||||
Log(u)
|
||||
Try
|
||||
' Buscamos el hash en la base de datos usando el usuario limpio
|
||||
Dim storedHash As String = Main.SQL1.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(u))
|
||||
' Buscamos el hash en la base de datos de autenticación (SQL_Auth)
|
||||
Dim storedHash As String = Main.SQL_Auth.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(u))
|
||||
Log($"${storedHash}"$)
|
||||
' Log($"${bc.checkpw(p, storedHash)}"$)
|
||||
|
||||
' Verificamos la contraseña contra el hash
|
||||
If storedHash <> Null And bc.checkpw(p, storedHash) Then
|
||||
' CREDENCIALES CORRECTAS
|
||||
' 1. Autorizamos la sesión
|
||||
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)
|
||||
|
||||
resp.SendRedirect("/manager")
|
||||
Else
|
||||
' Credenciales incorrectas
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -4,7 +4,7 @@ ModulesStructureVersion=1
|
||||
Type=Class
|
||||
Version=6.01
|
||||
@EndOfDesignText@
|
||||
'Class module
|
||||
'Class module : HikariConnectionPool
|
||||
'Author: Oliver Ackermann
|
||||
'Created on: 2018/05/07
|
||||
'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
|
||||
Dim properties As Map
|
||||
properties.Initialize
|
||||
'
|
||||
|
||||
'Frequently used
|
||||
properties.Put("autocommit", "boolean")
|
||||
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("setPassword", Array As Object(aPassword))
|
||||
If poolSize > 0 Then poolJO.RunMethod("setMaximumPoolSize", Array As Object(poolSize))
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub CreatePool3(options As Map)
|
||||
@@ -85,7 +84,7 @@ End Sub
|
||||
'that HikariConfig object.
|
||||
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_CONN_TIMEOUT As Long = 30000
|
||||
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_MAX_SIZE As Int = 10
|
||||
Private const DEFAULT_KEEP_ALIVE_TIME As Long = 300000
|
||||
|
||||
|
||||
Dim rawValue As String
|
||||
Dim processedKeys As List
|
||||
processedKeys.Initialize
|
||||
|
||||
Dim maxSize As Int ' Variable temporal para el tamaño máximo calculado
|
||||
|
||||
' --- INICIO: Procesamiento de Propiedades Críticas ---
|
||||
|
||||
' 1. MaxLifetime (Long) - Clave: maxlifetime
|
||||
|
||||
Dim maxSize As Int ' Temporary variable for the calculated maximum size
|
||||
|
||||
' 1. MaxLifetime (Long) - Key: maxlifetime
|
||||
Dim maxLife As Long
|
||||
If properties.ContainsKey("maxlifetime") Then
|
||||
rawValue = properties.Get("maxlifetime").As(String).Trim
|
||||
maxLife = rawValue
|
||||
poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife))
|
||||
Log($"Ponemos (LONG, Config): MaxLifetime, ${maxLife}"$)
|
||||
Log($"Ponemos MaxLifetime: ${maxLife}"$)
|
||||
Else
|
||||
maxLife = DEFAULT_MAX_LIFE
|
||||
poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife))
|
||||
Log($"Ponemos (LONG, Default): MaxLifetime, ${DEFAULT_MAX_LIFE}"$)
|
||||
End If
|
||||
processedKeys.Add("maxlifetime")
|
||||
MaxLifeConfig = maxLife ' <-- ALMACENAMIENTO CRÍTICO
|
||||
|
||||
' 2. ConnectionTimeout (Long) - Clave: connectiontimeout
|
||||
MaxLifeConfig = maxLife ' Store the config value
|
||||
|
||||
' 2. ConnectionTimeout (Long) - Key: connectiontimeout
|
||||
Dim connTimeout As Long
|
||||
If properties.ContainsKey("connectiontimeout") Then
|
||||
rawValue = properties.Get("connectiontimeout").As(String).Trim
|
||||
connTimeout = rawValue
|
||||
poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout))
|
||||
Log($"Ponemos (LONG, Config): ConnectionTimeout, ${connTimeout}"$)
|
||||
Log($"Ponemos ConnectionTimeout: ${connTimeout}"$)
|
||||
Else
|
||||
connTimeout = DEFAULT_CONN_TIMEOUT
|
||||
poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout))
|
||||
Log($"Ponemos (LONG, Default): ConnectionTimeout, ${DEFAULT_CONN_TIMEOUT}"$)
|
||||
Log($"Ponemos ConnectionTimeout: ${DEFAULT_CONN_TIMEOUT}"$)
|
||||
End If
|
||||
processedKeys.Add("connectiontimeout")
|
||||
ConnTimeoutConfig = connTimeout ' <-- ALMACENAMIENTO CRÍTICO
|
||||
|
||||
' 3. LeakDetectionThreshold (Long) - Clave: leakdetectionthreshold
|
||||
ConnTimeoutConfig = connTimeout ' Store the config value
|
||||
|
||||
' 3. LeakDetectionThreshold (Long) - Key: leakdetectionthreshold
|
||||
Dim leakThr As Long
|
||||
If properties.ContainsKey("leakdetectionthreshold") Then
|
||||
rawValue = properties.Get("leakdetectionthreshold").As(String).Trim
|
||||
leakThr = rawValue
|
||||
poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr))
|
||||
Log($"Ponemos (LONG, Config): LeakDetectionThreshold, ${leakThr}"$)
|
||||
Log($"Ponemos LeakDetectionThreshold: ${leakThr}"$)
|
||||
Else
|
||||
leakThr = DEFAULT_LEAK_THR
|
||||
poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr))
|
||||
Log($"Ponemos (LONG, Default): LeakDetectionThreshold, ${DEFAULT_LEAK_THR}"$)
|
||||
End If
|
||||
processedKeys.Add("leakdetectionthreshold")
|
||||
LeakDetectionThresholdConfig = leakThr ' <-- ALMACENAMIENTO CRÍTICO
|
||||
LeakDetectionThresholdConfig = leakThr ' Store the config value
|
||||
|
||||
|
||||
' ********** LÓGICA DE FIXED POOL: MaximumPoolSize primero **********
|
||||
|
||||
' 4. MaximumPoolSize (Int) - Clave: maximumpoolsize
|
||||
' 4. MaximumPoolSize (Int) - Key: maximumpoolsize
|
||||
If properties.ContainsKey("maximumpoolsize") Then
|
||||
rawValue = properties.Get("maximumpoolsize").As(String).Trim
|
||||
maxSize = rawValue.As(Int)
|
||||
poolJO.RunMethod("setMaximumPoolSize", Array As Object(maxSize))
|
||||
Log($"Ponemos (INT, Config): MaximumPoolSize, ${maxSize}"$)
|
||||
Log($"Ponemos MaximumPoolSize: ${maxSize}"$)
|
||||
Else
|
||||
maxSize = 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
|
||||
processedKeys.Add("maximumpoolsize")
|
||||
PoolSizeConfig = maxSize ' <-- ALMACENAMIENTO CRÍTICO
|
||||
|
||||
' 5. MinimumIdle (Int) - Clave: minimumidle
|
||||
PoolSizeConfig = maxSize ' Store the config value
|
||||
|
||||
' 5. MinimumIdle (Int) - Key: minimumidle
|
||||
Dim minIdleFinal As Int
|
||||
If properties.ContainsKey("minimumidle") Then
|
||||
rawValue = properties.Get("minimumidle").As(String).Trim
|
||||
minIdleFinal = rawValue.As(Int)
|
||||
poolJO.RunMethod("setMinimumIdle", Array As Object(minIdleFinal))
|
||||
Log($"Ponemos (INT, Config): MinimumIdle, ${minIdleFinal}"$)
|
||||
Log($"Ponemos MinimumIdle: ${minIdleFinal}"$)
|
||||
Else
|
||||
' APLICAMOS EL FIXED POOL AXIOM: MinimumIdle = MaximumPoolSize (maxSize)
|
||||
' APPLY FIXED POOL AXIOM: MinimumIdle = MaximumPoolSize (maxSize)
|
||||
minIdleFinal = maxSize
|
||||
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
|
||||
processedKeys.Add("minimumidle")
|
||||
MinIdleConfig = minIdleFinal ' <-- ALMACENAMIENTO CRÍTICO
|
||||
|
||||
' ********** FIN DE LA LÓGICA DE FIXED POOL **********
|
||||
|
||||
' 6. RegisterMbeans (Boolean) - Clave: registermbeans
|
||||
MinIdleConfig = minIdleFinal ' Store the config value
|
||||
|
||||
' 6. RegisterMbeans (Boolean) - Key: registermbeans
|
||||
If properties.ContainsKey("registermbeans") Then
|
||||
Dim regMbeans As Boolean = properties.Get("registermbeans")
|
||||
poolJO.RunMethod("setRegisterMbeans", Array As Object(regMbeans))
|
||||
Log($"Ponemos (BOOL, Config): RegisterMbeans, ${regMbeans}"$)
|
||||
Log($"Ponemos RegisterMbeans: ${regMbeans}"$)
|
||||
Else
|
||||
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
|
||||
processedKeys.Add("registermbeans")
|
||||
|
||||
' 7. KeepaliveTime (Long) - Clave: keepalivetime
|
||||
|
||||
' 7. KeepaliveTime (Long) - Key: keepalivetime
|
||||
Dim keepAlive As Long
|
||||
If properties.ContainsKey("keepalivetime") Then
|
||||
rawValue = properties.Get("keepalivetime").As(String).Trim
|
||||
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
|
||||
|
||||
poolJO.RunMethod("setKeepaliveTime", Array As Object(keepAlive))
|
||||
@@ -206,13 +198,12 @@ Public Sub SetProperties(properties As Map)
|
||||
Else
|
||||
keepAlive = DEFAULT_KEEP_ALIVE_TIME
|
||||
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
|
||||
processedKeys.Add("keepalivetime")
|
||||
KeepAliveTimeConfig = keepAlive ' <-- ALMACENAMIENTO CRÍTICO
|
||||
|
||||
' --- INICIO: PROCESAMIENTO DE PROPIEDADES RESTANTES ---
|
||||
' ... (El resto del código de procesamiento de propiedades restantes se mantiene igual)
|
||||
KeepAliveTimeConfig = keepAlive ' Store the config value
|
||||
|
||||
' Process remaining properties
|
||||
Dim intValue As Int
|
||||
Dim booleanValue As Boolean
|
||||
Dim variableType As String
|
||||
@@ -238,9 +229,9 @@ Public Sub SetProperties(properties As Map)
|
||||
Else
|
||||
Log($"Connection pool property ${k} has unsupported variable type of ${variableType}"$)
|
||||
End If
|
||||
Log($"Ponemos (Restante): ${k}, ${properties.Get(k)}"$)
|
||||
Log($"Ponemos (Remaining): ${k}, ${properties.Get(k)}"$)
|
||||
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
|
||||
Else
|
||||
Log($"Warning: Property ${k} not supported"$)
|
||||
@@ -249,23 +240,19 @@ Public Sub SetProperties(properties As Map)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
' // ---------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
' // NUEVA SUBRUTINA: Aplica propiedades específicas del Driver JDBC (Ej: MySQL caching)
|
||||
' // Estas propiedades se aplican usando addDataSourceProperty, que no se soporta en SetProperties estándar.
|
||||
' // ---------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
' Applies specific JDBC Driver properties (e.g., MySQL caching)
|
||||
' These properties are applied using addDataSourceProperty, which is not supported in standard SetProperties.
|
||||
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
|
||||
For Each k As String In properties.Keys
|
||||
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))
|
||||
Log($"HikariCP: Driver Property [${k}] added with value: ${value}"$)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
'Check if JDBC URL is supported
|
||||
Public Sub SupportUrl(jdbcUrl As String) As Boolean
|
||||
If jdbcUrl.StartsWith("jdbc:sqlite") Then
|
||||
@@ -300,48 +287,47 @@ Public Sub ClosePool
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
' ** ADVERTENCIA: Esta subrutina traduce los nombres de métodos internos de HikariCP
|
||||
' ** a las claves genéricas (ej. BusyConnections) que RDCConnector espera.
|
||||
' ** CRÍTICO: Ahora incluye la CONFIGURACIÓN ESTÁTICA guardada en las variables de clase.
|
||||
' WARNING: This subroutine translates internal HikariCP method names
|
||||
' to the generic keys (e.g., BusyConnections) that RDCConnector expects.
|
||||
' It now includes the STATIC CONFIGURATION saved in the class variables.
|
||||
Public Sub GetStats As Map
|
||||
Dim stats As Map
|
||||
stats.Initialize
|
||||
|
||||
' 1. AGREGAR PROPIEDADES ESTÁTICAS (CONFIGURACIÓN ALMACENADA)
|
||||
|
||||
' 1. ADD STATIC PROPERTIES (STORED CONFIGURATION)
|
||||
stats.Put("MaxPoolSize", PoolSizeConfig)
|
||||
stats.Put("MinPoolSize", MinIdleConfig)
|
||||
stats.Put("MaxLifetime", MaxLifeConfig)
|
||||
stats.Put("ConnectionTimeout", ConnTimeoutConfig)
|
||||
stats.Put("LeakDetectionThreshold", LeakDetectionThresholdConfig)
|
||||
stats.Put("KeepaliveTime", KeepAliveTimeConfig)
|
||||
' Nota: Aquí puedes agregar las propiedades estáticas adicionales que sean relevantes.
|
||||
|
||||
' 2. OBTENER MÉTRICAS DE TIEMPO DE EJECUCIÓN (JMX/MBean)
|
||||
' Note: You can add other relevant static properties here.
|
||||
|
||||
' 2. GET RUNTIME METRICS (JMX/MBean)
|
||||
If poolJO.IsInitialized Then
|
||||
Try
|
||||
Dim poolMBean As JavaObject = poolJO.RunMethod("getHikariPoolMXBean", Null)
|
||||
|
||||
|
||||
Dim busyConn As Object = poolMBean.RunMethod("getActiveConnections", Null)
|
||||
stats.Put("BusyConnections", busyConn)
|
||||
|
||||
|
||||
Dim idleConn As Object = poolMBean.RunMethod("getIdleConnections", Null)
|
||||
stats.Put("IdleConnections", idleConn)
|
||||
|
||||
|
||||
Dim activeCount As Int = busyConn
|
||||
Dim idleCount As Int = idleConn
|
||||
stats.Put("TotalConnections", activeCount + idleCount)
|
||||
|
||||
|
||||
Dim awaitingConn As Object = poolMBean.RunMethod("getThreadsAwaitingConnection", Null)
|
||||
stats.Put("ThreadsAwaitingConnection", awaitingConn)
|
||||
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)
|
||||
stats.Put("Error_Runtime", ErrorMsg)
|
||||
End Try
|
||||
Else
|
||||
stats.Put("Error", "Pool JO no inicializado")
|
||||
stats.Put("Error", "Pool JO not initialized")
|
||||
End If
|
||||
|
||||
|
||||
Return stats
|
||||
End Sub
|
||||
End Sub
|
||||
|
||||
492
Manager.bas
492
Manager.bas
@@ -4,34 +4,30 @@ ModulesStructureVersion=1
|
||||
Type=Class
|
||||
Version=10.3
|
||||
@EndOfDesignText@
|
||||
' Módulo de clase: Manager
|
||||
' Este handler proporciona un panel de administración web para el servidor jRDC2-Multi.
|
||||
' Permite monitorear el estado del servidor, recargar configuraciones de bases de datos,
|
||||
' ver estadísticas de rendimiento, reiniciar servicios externos, y gestionar la autenticación de usuarios.
|
||||
' Class module: Manager
|
||||
' This handler provides a web administration panel for the jRDC2-Multi server.
|
||||
' It allows monitoring server status, reloading database configurations,
|
||||
' viewing performance statistics, restarting external services, and managing user authentication.
|
||||
|
||||
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
|
||||
' 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
|
||||
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
|
||||
' 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
|
||||
|
||||
' Método principal que maneja las peticiones HTTP para el panel de administración.
|
||||
' req: El objeto ServletRequest que contiene la información de la petición entrante.
|
||||
' resp: El objeto ServletResponse para construir y enviar la respuesta al cliente.
|
||||
' Módulo de clase: Manager
|
||||
' ... (tu código de Class_Globals e Initialize se queda igual) ...
|
||||
|
||||
' Método principal que maneja las peticiones HTTP para el panel de administración.
|
||||
' Refactorizado para funcionar como una API con un frontend estático.
|
||||
' Main method that handles HTTP requests for the administration panel.
|
||||
' req: The ServletRequest object containing incoming request information.
|
||||
' resp: The ServletResponse object for building and sending the response to the client.
|
||||
' Refactored to work as an API with a static frontend.
|
||||
Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
|
||||
' --- 1. Bloque de Seguridad ---
|
||||
' Security Block
|
||||
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then
|
||||
resp.SendRedirect("/login")
|
||||
Return
|
||||
@@ -39,7 +35,7 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
|
||||
Dim Command As String = req.GetParameter("command")
|
||||
|
||||
' --- 2. Servidor de la Página Principal ---
|
||||
' Main Page Server
|
||||
If Command = "" Then
|
||||
Try
|
||||
resp.ContentType = "text/html; charset=utf-8"
|
||||
@@ -50,10 +46,10 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
Return
|
||||
End If
|
||||
|
||||
' --- 3. Manejo de Comandos como API ---
|
||||
' API Command Handling
|
||||
Select Command.ToLowerCase
|
||||
|
||||
' --- Comandos que devuelven JSON (Métricas del Pool) ---
|
||||
|
||||
' Commands that return JSON (Pool Metrics)
|
||||
Case "getstatsold"
|
||||
resp.ContentType = "application/json; charset=utf-8"
|
||||
Dim allPoolStats As Map
|
||||
@@ -63,49 +59,107 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
If connector.IsInitialized Then
|
||||
allPoolStats.Put(dbKey, connector.GetPoolStats)
|
||||
Else
|
||||
allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado"))
|
||||
allPoolStats.Put(dbKey, CreateMap("Error": "Connector not initialized"))
|
||||
End If
|
||||
Next
|
||||
j.Initialize(allPoolStats)
|
||||
resp.Write(j.ToString)
|
||||
Return
|
||||
|
||||
|
||||
Case "getstats"
|
||||
resp.ContentType = "application/json; charset=utf-8"
|
||||
Dim allPoolStats As Map
|
||||
|
||||
' Leemos del caché global actualizado por el Timer SSE
|
||||
|
||||
' We read from the global cache updated by the SSE Timer
|
||||
allPoolStats = Main.LatestPoolStats
|
||||
|
||||
|
||||
For Each dbKey As String In Main.listaDeCP
|
||||
If allPoolStats.ContainsKey(dbKey) = False Then
|
||||
allPoolStats.Put(dbKey, CreateMap("Error": "Métricas no disponibles/Pool no inicializado"))
|
||||
allPoolStats.Put(dbKey, CreateMap("Error": "Metrics unavailable/Pool not initialized"))
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
j.Initialize(allPoolStats)
|
||||
resp.Write(j.ToString)
|
||||
Return
|
||||
|
||||
|
||||
Case "slowqueries"
|
||||
|
||||
resp.ContentType = "application/json; charset=utf-8"
|
||||
Dim results As List
|
||||
results.Initialize
|
||||
|
||||
|
||||
Try
|
||||
' Verifica la existencia de la tabla de logs antes de consultar
|
||||
Dim tableExists As Boolean = Main.SQL1.ExecQuerySingleResult($"SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs';"$) <> Null
|
||||
|
||||
' --- 1. VALIDACIÓN Y PARSEO DEFENSIVO DE PARÁMETROS ---
|
||||
|
||||
' 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
|
||||
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)
|
||||
Return
|
||||
End If
|
||||
|
||||
' Consulta las 20 queries más lentas de la última hora
|
||||
Dim oneHourAgoMs As Long = DateTime.Now - 3600000
|
||||
Dim rs As ResultSet = Main.SQL1.ExecQuery($"SELECT query_name, duration_ms, datetime(timestamp / 1000, 'unixepoch', 'localtime') as timestamp_local, db_key, client_ip, busy_connections, handler_active_requests FROM query_logs WHERE timestamp >= ${oneHourAgoMs} ORDER BY duration_ms DESC LIMIT 20"$)
|
||||
|
||||
|
||||
' Calcular el tiempo de corte (flexible)
|
||||
Dim cutOffTimeMs As Long = DateTime.Now - (minutes * 60000)
|
||||
|
||||
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
|
||||
Dim row As Map
|
||||
row.Initialize
|
||||
@@ -118,33 +172,39 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
row.Put("Peticiones_Activas", rs.GetInt("handler_active_requests"))
|
||||
results.Add(row)
|
||||
Loop
|
||||
|
||||
rs.Close
|
||||
|
||||
|
||||
Dim root As Map
|
||||
root.Initialize
|
||||
root.Put("data", results)
|
||||
|
||||
' 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)
|
||||
resp.Write(j.ToString)
|
||||
|
||||
|
||||
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
|
||||
|
||||
Dim root As Map
|
||||
root.Initialize
|
||||
root.Put("data", results)
|
||||
j.Initialize(root)
|
||||
j.Initialize(CreateMap("message": "Error interno al procesar logs. Detalle: " & LastException.Message))
|
||||
resp.Write(j.ToString)
|
||||
End Try
|
||||
|
||||
Return
|
||||
|
||||
|
||||
Case "logs", "totalrequests", "totalblocked"
|
||||
resp.ContentType = "application/json; charset=utf-8"
|
||||
Dim mp As Map
|
||||
If Command = "logs" And GlobalParameters.mpLogs.IsInitialized Then mp = GlobalParameters.mpLogs
|
||||
If Command = "totalrequests" And GlobalParameters.mpTotalRequests.IsInitialized Then mp = GlobalParameters.mpTotalRequests
|
||||
If Command = "totalblocked" And GlobalParameters.mpBlockConnection.IsInitialized Then mp = GlobalParameters.mpBlockConnection
|
||||
|
||||
|
||||
If mp.IsInitialized Then
|
||||
j.Initialize(mp)
|
||||
resp.Write(j.ToString)
|
||||
@@ -152,108 +212,107 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
resp.Write("{}")
|
||||
End If
|
||||
Return
|
||||
|
||||
' --- Comandos que devuelven TEXTO PLANO ---
|
||||
|
||||
' Commands that return PLAIN TEXT
|
||||
Case "ping"
|
||||
resp.ContentType = "text/plain"
|
||||
resp.Write($"Pong ($DateTime{DateTime.Now})"$)
|
||||
Return
|
||||
|
||||
|
||||
Case "reload"
|
||||
resp.ContentType = "text/plain; charset=utf-8"
|
||||
Dim sbTemp As StringBuilder
|
||||
sbTemp.Initialize
|
||||
|
||||
' ***** LÓGICA DE RECARGA GRANULAR/SELECTIVA *****
|
||||
Dim dbKeyToReload As String = req.GetParameter("db").ToUpperCase ' Leer parámetro 'db' opcional (ej: /manager?command=reload&db=DB3)
|
||||
Dim targets As List ' Lista de DBKeys a recargar.
|
||||
|
||||
Dim dbKeyToReload As String = req.GetParameter("db").ToUpperCase ' Read optional 'db' parameter (e.g., /manager?command=reload&db=DB3)
|
||||
Dim targets As List ' List of DBKeys to reload.
|
||||
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
|
||||
' Recarga selectiva
|
||||
' Selective reload
|
||||
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
|
||||
End If
|
||||
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
|
||||
' Recarga completa (comportamiento por defecto)
|
||||
' Full reload (default behavior)
|
||||
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
|
||||
|
||||
' 2. Deshabilitar el Timer de logs (si es necesario)
|
||||
|
||||
' 2. Disable the log Timer (if necessary)
|
||||
Dim oldTimerState As Boolean = Main.timerLogs.Enabled
|
||||
If oldTimerState Then
|
||||
Main.timerLogs.Enabled = False
|
||||
sbTemp.Append(" -> Timer de limpieza de logs (SQLite) detenido temporalmente.").Append(" " & CRLF)
|
||||
sbTemp.Append(" -> Log cleanup timer (SQLite) stopped temporarily.").Append(" " & CRLF)
|
||||
End If
|
||||
|
||||
|
||||
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
|
||||
|
||||
' 3. Procesar solo los conectores objetivos
|
||||
|
||||
' 3. Process only the target connectors
|
||||
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
|
||||
|
||||
|
||||
Try
|
||||
' Crear el nuevo conector con la configuración fresca
|
||||
' Create the new connector with the fresh configuration
|
||||
newRDC.Initialize(dbKey)
|
||||
|
||||
' Adquirimos el lock para el reemplazo atómico
|
||||
|
||||
' Acquire the lock for atomic replacement
|
||||
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)
|
||||
|
||||
' Reemplazo atómico en el mapa global compartido
|
||||
|
||||
' Atomic replacement in the shared global map
|
||||
Main.Connectors.Put(dbKey, newRDC)
|
||||
|
||||
' Liberamos el bloqueo inmediatamente
|
||||
|
||||
' Release the lock immediately
|
||||
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
|
||||
oldConnectorsToClose.Put(dbKey, oldRDC)
|
||||
End If
|
||||
|
||||
' 4. Actualizar el estado de logs (Granular)
|
||||
' 4. Update log status (Granular)
|
||||
Dim enableLogsSetting As Int = newRDC.config.GetDefault("enableSQLiteLogs", 0)
|
||||
Dim isEnabled As Boolean = (enableLogsSetting = 1)
|
||||
Main.SQLiteLoggingStatusByDB.Put(dbKey, isEnabled)
|
||||
sbTemp.Append($" -> ${dbKey} recargado. Logs (config): ${isEnabled}"$).Append(CRLF)
|
||||
|
||||
sbTemp.Append($" -> ${dbKey} reloaded. Logs (config): ${isEnabled}"$).Append(CRLF)
|
||||
|
||||
Catch
|
||||
' Si falla la inicialización del pool, no actualizamos Main.Connectors
|
||||
|
||||
' ¡CRÍTICO! Aseguramos que el lock se libere si hubo excepción antes de liberar.
|
||||
' If pool initialization fails, we don't update Main.Connectors
|
||||
|
||||
' Ensure the lock is released if an exception occurred before release.
|
||||
If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then
|
||||
Main.MainConnectorsLock.RunMethod("unlock", Null)
|
||||
End If
|
||||
|
||||
sbTemp.Append($" -> ERROR CRÍTICO al inicializar conector para ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF)
|
||||
|
||||
sbTemp.Append($" -> CRITICAL ERROR initializing connector for ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF)
|
||||
reloadSuccessful = False
|
||||
Exit
|
||||
End Try
|
||||
Next
|
||||
|
||||
' 5. Cerrar los pools antiguos liberados (FUERA del Lock)
|
||||
|
||||
' 5. Close the old released pools (OUTSIDE the Lock)
|
||||
If reloadSuccessful Then
|
||||
For Each dbKey As String In oldConnectorsToClose.Keys
|
||||
Dim oldRDC As RDCConnector = oldConnectorsToClose.Get(dbKey)
|
||||
oldRDC.Close ' Cierre limpio del pool C3P0
|
||||
sbTemp.Append($" -> Pool antiguo de ${dbKey} cerrado limpiamente."$).Append(" " & CRLF)
|
||||
oldRDC.Close ' Clean closure of the C3P0 pool
|
||||
sbTemp.Append($" -> Old pool for ${dbKey} closed cleanly."$).Append(" " & CRLF)
|
||||
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
|
||||
|
||||
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
|
||||
Main.IsAnySQLiteLoggingEnabled = True
|
||||
Exit
|
||||
@@ -261,19 +320,19 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
Next
|
||||
If Main.IsAnySQLiteLoggingEnabled Then
|
||||
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
|
||||
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
|
||||
sbTemp.Append($"¡Recarga de configuración completada con éxito!"$).Append(" " & CRLF)
|
||||
sbTemp.Append($"Configuration reload completed successfully!"$).Append(" " & CRLF)
|
||||
Else
|
||||
' Si falló, restauramos el estado del timer anterior.
|
||||
' If it failed, restore the previous timer state.
|
||||
If oldTimerState Then
|
||||
Main.timerLogs.Enabled = True
|
||||
sbTemp.Append(" -> Restaurando Timer de limpieza de logs al estado ACTIVO debido a fallo en recarga.").Append(" " & CRLF)
|
||||
sbTemp.Append(" -> Restoring Log cleanup timer to ACTIVE state due to reload failure.").Append(" " & CRLF)
|
||||
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
|
||||
resp.Write(sbTemp.ToString)
|
||||
Return
|
||||
@@ -281,57 +340,57 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
resp.ContentType = "text/plain; charset=utf-8"
|
||||
Dim sb As StringBuilder
|
||||
sb.Initialize
|
||||
sb.Append("--- INICIANDO PRUEBA DE CONECTIVIDAD A TODOS LOS POOLS CONFIGURADOS ---").Append(CRLF).Append(CRLF)
|
||||
|
||||
' Iteramos sobre la lista de DB Keys cargadas al inicio (DB1, DB2, etc.)
|
||||
sb.Append("--- STARTING CONNECTIVITY TEST TO ALL CONFIGURED POOLS ---").Append(CRLF).Append(CRLF)
|
||||
|
||||
' We iterate over the list of DB Keys loaded at startup (DB1, DB2, etc.)
|
||||
For Each dbKey As String In Main.listaDeCP
|
||||
Dim success As Boolean = False
|
||||
Dim errorMsg As String = ""
|
||||
Dim con As SQL ' Conexión para la prueba
|
||||
|
||||
Dim con As SQL ' Connection for the test
|
||||
|
||||
Try
|
||||
' 1. Obtener el RDCConnector para esta DBKey
|
||||
' 1. Get the RDCConnector for this DBKey
|
||||
Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
|
||||
|
||||
|
||||
If connector.IsInitialized = False Then
|
||||
errorMsg = "Conector no inicializado (revisa logs de AppStart)"
|
||||
errorMsg = "Connector not initialized (check AppStart logs)"
|
||||
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)
|
||||
|
||||
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
|
||||
success = True
|
||||
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
|
||||
|
||||
|
||||
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
|
||||
End Try
|
||||
|
||||
|
||||
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
|
||||
' Si falla, registramos el error para el administrador.
|
||||
Main.LogServerError("ERROR", "Manager.TestCommand", $"Falló la prueba de conectividad para ${dbKey}: ${errorMsg}"$, dbKey, "test_command", req.RemoteAddress)
|
||||
sb.Append($"[FALLO] ${dbKey}: ERROR CRÍTICO al obtener conexión. Mensaje: ${errorMsg}"$).Append(CRLF)
|
||||
' If it fails, log the error for the administrator.
|
||||
Main.LogServerError("ERROR", "Manager.TestCommand", $"Connectivity test failed for ${dbKey}: ${errorMsg}"$, dbKey, "test_command", req.RemoteAddress)
|
||||
sb.Append($"[FAILED] ${dbKey}: CRITICAL ERROR getting connection. Message: ${errorMsg}"$).Append(CRLF)
|
||||
End If
|
||||
Next
|
||||
|
||||
sb.Append(CRLF).Append("--- FIN DE PRUEBA DE CONEXIONES ---").Append(CRLF)
|
||||
|
||||
' Mantenemos la lista original de archivos de configuración cargados (esto es informativo)
|
||||
sb.Append(CRLF).Append("Archivos de configuración cargados:").Append(CRLF)
|
||||
|
||||
sb.Append(CRLF).Append("--- END OF CONNECTION TEST ---").Append(CRLF)
|
||||
|
||||
' We keep the original list of loaded config files (this is informational)
|
||||
sb.Append(CRLF).Append("Loaded configuration files:").Append(CRLF)
|
||||
For Each item As String In Main.listaDeCP
|
||||
Dim configName As String = "config"
|
||||
If item <> "DB1" Then configName = configName & "." & item
|
||||
sb.Append($" -> Usando ${configName}.properties"$).Append(CRLF)
|
||||
sb.Append($" -> Using ${configName}.properties"$).Append(CRLF)
|
||||
Next
|
||||
|
||||
|
||||
resp.Write(sb.ToString)
|
||||
Return
|
||||
Case "rsx", "rpm2", "revivebow", "restartserver"
|
||||
@@ -341,161 +400,154 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
Case "rsx": batFile = "start.bat"
|
||||
Case "rpm2": batFile = "reiniciaProcesoPM2.bat"
|
||||
Case "reviveBow": batFile = "reiniciaProcesoBow.bat"
|
||||
Case "restartserver": batFile = "restarServer.bat" ' Nota: este bat no estaba definido, se usó el nombre del comando
|
||||
Case "restartserver": batFile = "restarServer.bat" ' Note: this bat was not defined, command name was used
|
||||
End Select
|
||||
|
||||
Log($"Ejecutando ${File.DirApp}\${batFile}"$)
|
||||
|
||||
Log($"Executing ${File.DirApp}\${batFile}"$)
|
||||
Try
|
||||
Dim shl As Shell
|
||||
shl.Initialize("shl","cmd", Array("/c", File.DirApp & "\" & batFile & " " & Main.srvr.Port))
|
||||
shl.WorkingDirectory = File.DirApp
|
||||
shl.Run(-1)
|
||||
resp.Write($"Comando '${Command}' ejecutado. Script invocado: ${batFile}"$)
|
||||
resp.Write($"Command '${Command}' executed. Script invoked: ${batFile}"$)
|
||||
Catch
|
||||
resp.Write($"Error al ejecutar el script para '${Command}': ${LastException.Message}"$)
|
||||
resp.Write($"Error executing script for '${Command}': ${LastException.Message}"$)
|
||||
End Try
|
||||
Return
|
||||
|
||||
|
||||
Case "paused", "continue"
|
||||
resp.ContentType = "text/plain; charset=utf-8"
|
||||
resp.ContentType = "text/plain; charset=utf-ab"
|
||||
If Command = "paused" Then
|
||||
GlobalParameters.IsPaused = 1
|
||||
resp.Write("Servidor pausado.")
|
||||
resp.Write("Server paused.")
|
||||
Else
|
||||
GlobalParameters.IsPaused = 0
|
||||
resp.Write("Servidor reanudado.")
|
||||
resp.Write("Server resumed.")
|
||||
End If
|
||||
Return
|
||||
|
||||
|
||||
Case "block", "unblock"
|
||||
resp.ContentType = "text/plain; charset=utf-8"
|
||||
Dim ip As String = req.GetParameter("IP")
|
||||
|
||||
|
||||
If ip = "" Then
|
||||
resp.Write("Error: El parámetro IP es requerido.")
|
||||
resp.Write("Error: The IP parameter is required.")
|
||||
Return
|
||||
End If
|
||||
|
||||
|
||||
If GlobalParameters.mpBlockConnection.IsInitialized Then
|
||||
If Command = "block" Then
|
||||
GlobalParameters.mpBlockConnection.Put(ip, ip)
|
||||
resp.Write($"IP bloqueada: ${ip}"$)
|
||||
resp.Write($"IP blocked: ${ip}"$)
|
||||
Else
|
||||
GlobalParameters.mpBlockConnection.Remove(ip)
|
||||
resp.Write($"IP desbloqueada: ${ip}"$)
|
||||
resp.Write($"IP unblocked: ${ip}"$)
|
||||
End If
|
||||
Else
|
||||
resp.Write("Error: El mapa de bloqueo no está inicializado.")
|
||||
resp.Write("Error: The block map is not initialized.")
|
||||
End If
|
||||
Return
|
||||
Case "getconfiginfo"
|
||||
|
||||
|
||||
resp.ContentType = "text/plain; charset=utf-8"
|
||||
Dim sbInfo As StringBuilder
|
||||
sbInfo.Initialize
|
||||
|
||||
|
||||
Dim allKeys As List
|
||||
allKeys.Initialize
|
||||
allKeys.AddAll(Main.listaDeCP)
|
||||
|
||||
|
||||
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)
|
||||
|
||||
' ***** GLOSARIO DE PARÁMETROS CONFIGURABLES *****
|
||||
sbInfo.Append("### GLOSARIO DE PARÁMETROS PERMITIDOS EN CONFIG.PROPERTIES (HIKARICP) ###").Append(CRLF)
|
||||
|
||||
sbInfo.Append("### GLOSSARY OF ALLOWED PARAMETERS IN CONFIG.PROPERTIES (HIKARICP) ###").Append(CRLF)
|
||||
sbInfo.Append("--------------------------------------------------").Append(CRLF)
|
||||
sbInfo.Append("DriverClass: Clase del driver JDBC (ej: 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("User/Password: Credenciales de acceso a la BD.").Append(CRLF)
|
||||
sbInfo.Append("ServerPort: Puerto de escucha del servidor B4J (solo lo toma de 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("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("enableSQLiteLogs: Control granular. Habilita (1) o deshabilita (0) la escritura de logs en users.db para esta DB.").Append(CRLF)
|
||||
|
||||
' --- Parámetros de HIKARICP (Foco en el mínimo set de tuning) ---
|
||||
sbInfo.Append("pool.hikari.maximumPoolSize: Máximo de conexiones simultáneas permitido. (Recomendado N*Cores DB),").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): 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): Tiempo máximo de espera del cliente por una conexión disponible (Default: 30000 ms),").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): Umbral (ms) para detectar conexiones no devueltas (fugas).").Append(CRLF)
|
||||
|
||||
sbInfo.Append("DriverClass: JDBC driver class (e.g., oracle.jdbc.driver.OracleDriver).").Append(CRLF)
|
||||
sbInfo.Append("JdbcUrl: Database connection URL (IP, port, service).").Append(CRLF)
|
||||
sbInfo.Append("User/Password: DB access credentials.").Append(CRLF)
|
||||
sbInfo.Append("ServerPort: B4J server listening port (only taken from config.properties).").Append(CRLF)
|
||||
sbInfo.Append("Debug: If 'true', SQL commands are reloaded on each request (DISABLED, USE RELOAD COMMAND).").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: Granular control. Enables (1) or disables (0) writing logs to users.db for this DB.").Append(CRLF)
|
||||
|
||||
sbInfo.Append("pool.hikari.maximumPoolSize: Maximum simultaneous connections allowed. (Recommended 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.maxLifetime (ms): Maximum lifetime of a connection. CRITICAL: Must be less than firewall/DB timeout,").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.idleTimeout (ms): Idle time before retiring the connection (ms). Only applies if minimumIdle < maximumPoolSize,").Append(CRLF)
|
||||
sbInfo.Append("pool.hikari.leakDetectionThreshold (ms): Threshold (ms) to detect unreturned connections (leaks).").Append(CRLF)
|
||||
|
||||
sbInfo.Append(CRLF)
|
||||
|
||||
|
||||
For Each dbKey As String In allKeys
|
||||
|
||||
' --- COMIENZA EL DETALLE POR CONECTOR ---
|
||||
|
||||
Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
|
||||
|
||||
|
||||
sbInfo.Append("--------------------------------------------------").Append(CRLF).Append(CRLF)
|
||||
sbInfo.Append($"---------------- ${dbKey} ------------------"$).Append(CRLF).Append(CRLF)
|
||||
|
||||
|
||||
If connector.IsInitialized Then
|
||||
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
|
||||
|
||||
|
||||
sbInfo.Append($"DriverClass: ${configMap.GetDefault("DriverClass", "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($"ServerPort: ${configMap.GetDefault("ServerPort", "N/A")}"$).Append(CRLF).Append(CRLF)
|
||||
|
||||
sbInfo.Append("--- CONFIGURACIÓN DEL POOL (HIKARICP - Valores Aplicados) ---").Append(CRLF)
|
||||
|
||||
sbInfo.Append($"MaximumPoolSize (Aplicado): ${poolStats.GetDefault("MaxPoolSize", 10).As(Int)}"$).Append(CRLF)
|
||||
sbInfo.Append($"MinimumIdle (Aplicado): ${poolStats.GetDefault("MinPoolSize", 10).As(Int)}"$).Append(CRLF)
|
||||
|
||||
' Reportamos los timeouts en Milisegundos (ms)
|
||||
|
||||
sbInfo.Append("--- POOL CONFIGURATION (HIKARICP - Applied Values) ---").Append(CRLF)
|
||||
|
||||
sbInfo.Append($"MaximumPoolSize (Applied): ${poolStats.GetDefault("MaxPoolSize", 10).As(Int)}"$).Append(CRLF)
|
||||
sbInfo.Append($"MinimumIdle (Applied): ${poolStats.GetDefault("MinPoolSize", 10).As(Int)}"$).Append(CRLF)
|
||||
|
||||
' Report timeouts in Milliseconds (ms)
|
||||
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($"IdleTimeout (ms): ${poolStats.GetDefault("IdleTimeout", 600000).As(Long)}"$).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
|
||||
|
||||
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
|
||||
Dim propValue As Object = connector.driverProperties.Get(propKey)
|
||||
sbInfo.Append($"[Driver] ${propKey}: ${propValue}"$).Append(CRLF)
|
||||
Next
|
||||
sbInfo.Append(CRLF)
|
||||
End If
|
||||
' *** FIN DE LA NUEVA SECCIÓN ***
|
||||
|
||||
' Reportamos métricas de runtime del pool (si están disponibles).
|
||||
sbInfo.Append("--- ESTADO DE RUNTIME (Métricas Dinámicas) ---").Append(CRLF)
|
||||
sbInfo.Append("--- RUNTIME STATUS (Dynamic Metrics) ---").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($"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("--- COMPORTAMIENTO ---").Append(CRLF)
|
||||
sbInfo.Append($"Debug (Recarga Queries - DESHABILITADO): ${configMap.GetDefault("Debug", "false")}"$).Append(CRLF)
|
||||
|
||||
|
||||
sbInfo.Append("--- BEHAVIOR ---").Append(CRLF)
|
||||
sbInfo.Append($"Debug (Reload Queries - DISABLED): ${configMap.GetDefault("Debug", "false")}"$).Append(CRLF)
|
||||
|
||||
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 logsEnabledRuntimeInt As Int = 0
|
||||
If isLogsEnabledRuntime Then
|
||||
logsEnabledRuntimeInt = 1
|
||||
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)
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
||||
Next
|
||||
|
||||
|
||||
resp.Write(sbInfo.ToString)
|
||||
Return
|
||||
|
||||
@@ -505,24 +557,22 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
Dim dbKeyToChange As String = req.GetParameter("db").ToUpperCase
|
||||
Dim status As String = req.GetParameter("status")
|
||||
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
|
||||
End If
|
||||
|
||||
|
||||
Dim isEnabled As Boolean = (status = "1")
|
||||
Dim resultMsg As String
|
||||
|
||||
' *** 1. Adquisición del Lock (CRÍTICO) ***
|
||||
Main.MainConnectorsLock.RunMethod("lock", Null)
|
||||
|
||||
Try
|
||||
' 2. Lógica Crítica de Modificación de Estado (Protegida)
|
||||
Main.SQLiteLoggingStatusByDB.Put(dbKeyToChange, isEnabled)
|
||||
|
||||
Private hab As String = "DESHABILITADOS"
|
||||
If isEnabled Then hab = "HABILITADOS"
|
||||
resultMsg = $"Logs de ${dbKeyToChange} ${hab} en caliente."$
|
||||
' 3. Re-evaluación del estado global
|
||||
|
||||
Private hab As String = "DISABLED"
|
||||
If isEnabled Then hab = "ENABLED"
|
||||
resultMsg = $"Logs for ${dbKeyToChange} ${hab} on-the-fly."$
|
||||
|
||||
Main.IsAnySQLiteLoggingEnabled = False
|
||||
For Each dbKey As String In Main.listaDeCP
|
||||
If Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False) Then
|
||||
@@ -531,27 +581,21 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
End If
|
||||
Next
|
||||
|
||||
' 4. Ajustar el Timer
|
||||
If Main.IsAnySQLiteLoggingEnabled Then
|
||||
If Main.timerLogs.Enabled = False Then Main.timerLogs.Enabled = True
|
||||
resultMsg = resultMsg & " Timer de limpieza ACTIVADO."
|
||||
resultMsg = resultMsg & " Cleanup timer ACTIVATED."
|
||||
Else
|
||||
Main.timerLogs.Enabled = False
|
||||
resultMsg = resultMsg & " Timer de limpieza DESHABILITADO globalmente."
|
||||
resultMsg = resultMsg & " Cleanup timer DISABLED globally."
|
||||
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
|
||||
Main.MainConnectorsLock.RunMethod("unlock", Null)
|
||||
End If
|
||||
|
||||
Catch
|
||||
' 5. Manejo de Excepción y ** LIBERACIÓN EN CASO DE FALLO **
|
||||
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.
|
||||
resultMsg = $"CRITICAL ERROR modifying log status: ${LastException.Message}"$
|
||||
|
||||
If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then
|
||||
Main.MainConnectorsLock.RunMethod("unlock", Null)
|
||||
End If
|
||||
@@ -559,10 +603,10 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
|
||||
|
||||
resp.Write(resultMsg)
|
||||
Return
|
||||
|
||||
|
||||
Case Else
|
||||
resp.ContentType = "text/plain; charset=utf-8"
|
||||
resp.SendError(404, $"Comando desconocido: '{Command}'"$)
|
||||
resp.SendError(404, $"Unknown command: '{Command}'"$)
|
||||
Return
|
||||
End Select
|
||||
End Sub
|
||||
End Sub
|
||||
|
||||
@@ -4,43 +4,43 @@ ModulesStructureVersion=1
|
||||
Type=StaticCode
|
||||
Version=10.3
|
||||
@EndOfDesignText@
|
||||
' Archivo: ParameterValidationUtils.bas
|
||||
' Módulo de utilidad: ParameterValidationUtils
|
||||
' Centraliza la lógica de validación y ajuste de parámetros SQL.
|
||||
' Ahora soporta recorte de parámetros excesivos.
|
||||
' File: ParameterValidationUtils.bas
|
||||
' Utility module: ParameterValidationUtils
|
||||
' Centralizes SQL parameter validation and adjustment logic.
|
||||
' Now supports trimming of excessive parameters.
|
||||
|
||||
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
|
||||
|
||||
' Valida y ajusta la lista de parámetros para la ejecución SQL, aplicando la lógica de tolerancia.
|
||||
' Retorna un ParameterValidationResult indicando éxito/error y los parámetros a usar.
|
||||
' Validates and adjusts the parameter list for SQL execution, applying tolerance logic.
|
||||
' 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
|
||||
Dim res As ParameterValidationResult
|
||||
res.Initialize
|
||||
res.Success = True ' Asumimos éxito inicialmente
|
||||
|
||||
res.Success = True ' Assume success initially
|
||||
|
||||
' 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
|
||||
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
|
||||
|
||||
' 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 receivedParamsSize As Int = receivedParams.Size
|
||||
|
||||
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.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)
|
||||
Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null) ' <-- Nuevo Log
|
||||
Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null)
|
||||
Return res
|
||||
Else If receivedParamsSize > expectedParams Then
|
||||
' Caso 2: Se recibieron MÁS parámetros de los esperados.
|
||||
If IsToleranceEnabled Then ' Solo recortamos si la tolerancia está habilitada
|
||||
' More parameters were received than expected.
|
||||
If IsToleranceEnabled Then ' We only trim if tolerance is enabled
|
||||
Dim adjustedParams As List
|
||||
adjustedParams.Initialize
|
||||
For i = 0 To expectedParams - 1
|
||||
@@ -48,23 +48,23 @@ Public Sub ValidateAndAdjustParameters (CommandName As String, DBKey As String,
|
||||
Next
|
||||
res.ParamsToExecute = adjustedParams
|
||||
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("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
|
||||
' 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.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)
|
||||
Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null)
|
||||
Return res
|
||||
End If
|
||||
Else
|
||||
' Caso 3: Se recibieron el número EXACTO de parámetros. Todo bien.
|
||||
res.ParamsToExecute = receivedParams ' Usamos la lista original tal cual.
|
||||
res.Success = True ' Confirmamos éxito.
|
||||
' The EXACT number of parameters was received. All good.
|
||||
res.ParamsToExecute = receivedParams ' Use the original list as-is.
|
||||
res.Success = True ' Confirm success.
|
||||
End If
|
||||
|
||||
|
||||
Return res
|
||||
End Sub
|
||||
End Sub
|
||||
|
||||
155
RDCConnector.bas
155
RDCConnector.bas
@@ -4,171 +4,167 @@ ModulesStructureVersion=1
|
||||
Type=Class
|
||||
Version=4.19
|
||||
@EndOfDesignText@
|
||||
' Módulo de clase: RDCConnector
|
||||
' Esta clase gestiona el pool de conexiones a una base de datos específica.
|
||||
' REFRACTORIZADO: Usa ConnectionPoolManager y delega a HikariCP.
|
||||
' Class module: RDCConnector
|
||||
' This class manages the connection pool for a specific database.
|
||||
' Uses ConnectionPoolManager and delegates to HikariCP.
|
||||
|
||||
Sub Class_Globals
|
||||
' --- Variables globales de la clase ---
|
||||
Private pool As ConnectionPoolManager ' Usa el Manager para la modularidad
|
||||
Private MyHikariPool As HikariConnectionPool ' <-- NUEVO: Pool dedicado a esta DBKey.
|
||||
Private DebugQueries As Boolean = False ' Bandera para activar/desactivar el modo de depuración
|
||||
Public commands As Map ' Comandos SQL cargados
|
||||
' --- Class global variables ---
|
||||
Private MyHikariPool As HikariConnectionPool ' Dedicated pool for this DBKey.
|
||||
Private DebugQueries As Boolean = False ' Flag to enable/disable debug mode
|
||||
Public commands As Map ' Loaded SQL commands
|
||||
Public serverPort As Int
|
||||
Public usePool As Boolean = True
|
||||
Public config As Map ' Configuración completa (JdbcUrl, User, Password, etc.)
|
||||
Public IsParameterToleranceEnabled As Boolean ' Tolerancia a parámetros de más
|
||||
Dim driverProperties As Map ' CRÍTICO: Propiedades específicas del driver (MySQL statement caching)
|
||||
Private configLocation As String ' Ubicación del archivo de configuración
|
||||
Public config As Map ' Complete configuration (JdbcUrl, User, Password, etc.)
|
||||
Public IsParameterToleranceEnabled As Boolean ' Tolerance for extra parameters
|
||||
Dim driverProperties As Map ' Specific driver properties (MySQL statement caching)
|
||||
Private configLocation As String ' Configuration file location
|
||||
Private poolProperties As Map
|
||||
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)
|
||||
' Nota: Este código asume que MyHikariPool ya está declarado en Class_Globals
|
||||
Dim dbKey As String = DB ' Usaremos DB como la llave
|
||||
' Note: This code assumes MyHikariPool is already declared in Class_Globals
|
||||
Dim dbKey As String = DB ' We will use DB as the key
|
||||
If DB.EqualsIgnoreCase("DB1") Then dbKey = ""
|
||||
|
||||
poolProperties.Initialize
|
||||
driverProperties.Initialize
|
||||
|
||||
' PASO 1: Cargar la configuración desde el archivo .properties correspondiente.
|
||||
config = LoadConfigMap(dbKey) ' Aseguramos la carga en la variable de clase [1]
|
||||
' Load the configuration from the corresponding .properties file.
|
||||
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)
|
||||
IsParameterToleranceEnabled = (toleranceSetting = 1)
|
||||
|
||||
If IsParameterToleranceEnabled Then
|
||||
Log($"RDCConnector.Initialize para ${dbKey}: Tolerancia a parámetros extras, HABILITADA."$)
|
||||
Log($"RDCConnector.Initialize for ${dbKey}: Extra parameter tolerance ENABLED."$)
|
||||
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
|
||||
|
||||
' Bloque Try-Catch para la inicialización y configuración del pool.
|
||||
' Try-Catch block for pool initialization and configuration.
|
||||
Try
|
||||
Dim driverClass As String = config.Get("DriverClass")
|
||||
Dim jdbcUrl As String = config.Get("JdbcUrl")
|
||||
Dim aUser As String = config.Get("User")
|
||||
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 poolSizeString As String
|
||||
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
|
||||
poolSizeString = config.Get(maxSizeKey)
|
||||
poolSize = poolSizeString.As(Int)
|
||||
Else
|
||||
' Si no está definido, usamos el default recomendado por Hikari (10). [2]
|
||||
' If not defined, use the recommended Hikari default (10).
|
||||
poolSize = 10
|
||||
End If
|
||||
|
||||
If poolSize < 1 Then poolSize = 10 ' Mantenemos la sensatez
|
||||
Log($"RDCConnector: Usando MaximumPoolSize para ${poolType} calculado: ${poolSize}"$)
|
||||
If poolSize < 1 Then poolSize = 10 ' Keep it sensible
|
||||
Log($"RDCConnector: Using MaximumPoolSize for ${poolType} calculated: ${poolSize}"$)
|
||||
|
||||
' *** PASO 2: INICIALIZA/CREA EL POOL LOCALMENTE (Decoupling CRÍTICO) ***
|
||||
|
||||
If MyHikariPool.IsInitialized = False Then MyHikariPool.Initialize ' Inicializa el wrapper local
|
||||
|
||||
' Crea el pool subyacente (DataSource) en esta instancia dedicada. [3]
|
||||
' Initialize/Create the pool locally
|
||||
|
||||
If MyHikariPool.IsInitialized = False Then MyHikariPool.Initialize ' Initialize the local wrapper
|
||||
|
||||
' Create the underlying pool (DataSource) in this dedicated instance.
|
||||
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)
|
||||
|
||||
' PASO 3b: Aplicar propiedades de ESTABILIDAD (Pool Properties)
|
||||
' Apply STABILITY properties (Pool Properties)
|
||||
If poolProperties.Size > 0 Then
|
||||
' Aplicación directa al pool local. [4]
|
||||
' Direct application to the local pool.
|
||||
CallSub2(MyHikariPool, "SetProperties", poolProperties)
|
||||
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
|
||||
LoadDriverProperties(config.Get("DriverShortName"), config)
|
||||
End If
|
||||
|
||||
' PASO 5: Aplicar propiedades de RENDIMIENTO (Driver Properties)
|
||||
' Apply PERFORMANCE properties (Driver Properties)
|
||||
If driverProperties.Size > 0 Then
|
||||
' Aplicación directa al pool local. [5]
|
||||
' Direct application to the local pool.
|
||||
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
|
||||
|
||||
' PASO 6 (Prueba de vida): Forzar la creación de conexiones iniciales y verificar el estado.
|
||||
' Esto garantiza el fail-fast. [6]
|
||||
' Force initial connection creation and check status.
|
||||
' This ensures fail-fast.
|
||||
Dim tempCon As SQL = MyHikariPool.GetConnection
|
||||
If tempCon.IsInitialized Then
|
||||
tempCon.Close
|
||||
End If
|
||||
|
||||
' Cargar configuración estática en el cache global
|
||||
' Load static configuration into the global cache
|
||||
Dim dbKeyToStore As String = DB
|
||||
If dbKeyToStore = "" Then dbKeyToStore = "DB1"
|
||||
|
||||
' Almacenamos el mapa completo (configuración estática + métricas dinámicas iniciales) en el cache global.
|
||||
' GetPoolStats ahora usa MyHikariPool.
|
||||
' Store the complete map (static config + initial dynamic metrics) in the global cache.
|
||||
' GetPoolStats now uses MyHikariPool.
|
||||
Dim initialPoolStats As Map = GetPoolStats
|
||||
Main.LatestPoolStats.Put(dbKeyToStore, initialPoolStats)
|
||||
|
||||
Catch
|
||||
' Si ocurre un error durante la inicialización del pool o al forzar la conexión.
|
||||
Dim ErrorMsg As String = $"RDCConnector.Initialize para ${DB}: ERROR CRÍTICO al inicializar/forzar conexión: ${LastException.Message}"$
|
||||
' If an error occurs during pool initialization or when forcing the connection.
|
||||
Dim ErrorMsg As String = $"RDCConnector.Initialize for ${DB}: CRITICAL ERROR initializing/forcing connection: ${LastException.Message}"$
|
||||
Log(ErrorMsg)
|
||||
Main.LogServerError("ERROR", "RDCConnector.Initialize", ErrorMsg, DB, Null, Null)
|
||||
|
||||
' Si falla la inicialización, la instancia local MyHikariPool se queda inutilizada.
|
||||
' Aquí podríamos considerar la opción de llamar a MyHikariPool.ClosePool para asegurar
|
||||
' que no queden recursos parciales, aunque HikariCP debería manejarse con fail-fast.
|
||||
|
||||
' If initialization fails, the local MyHikariPool instance remains unusable.
|
||||
' We could consider calling MyHikariPool.ClosePool here to ensure
|
||||
' that no partial resources are left, although HikariCP should handle fail-fast.
|
||||
|
||||
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"
|
||||
LoadSQLCommands(config, dbKey)
|
||||
serverPort = config.Get("ServerPort")
|
||||
|
||||
End Sub
|
||||
|
||||
' Carga el mapa de configuración
|
||||
' Load the configuration map
|
||||
Private Sub LoadConfigMap(DB As String) As Map
|
||||
Private DBX As String = ""
|
||||
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")
|
||||
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
|
||||
commands = Main.commandsMap.Get(DB).As(Map)
|
||||
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)
|
||||
Main.LogServerError("ERROR", "RDCConnector.GetCommand", ErrorMsg, DB, Key, Null)
|
||||
End If
|
||||
Return commands.Get("sql." & Key)
|
||||
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
|
||||
' If DB.EqualsIgnoreCase("DB1") Then DB = ""
|
||||
' If DebugQueries Then LoadSQLCommands(LoadConfigMap(DB), DB) ' Deshabilitado por defecto. [13]
|
||||
|
||||
' Devolvemos la conexión del pool local, si está inicializado.
|
||||
' El ConnectionPoolManager ha sido removido. La delegación debe ir directamente
|
||||
' al pool dedicado de HikariCP. Esto simplifica la ruta crítica.
|
||||
If MyHikariPool.IsInitialized Then
|
||||
Return MyHikariPool.GetConnection
|
||||
Else
|
||||
Log($"ERROR: Intento de obtener conexión de DBKey ${DB}, pero MyHikariPool no está inicializado."$)
|
||||
' Devolver Null o lanzar excepción, dependiendo del manejo de errores deseado.
|
||||
Log($"ERROR: Attempt to get connection for DBKey ${DB}, but MyHikariPool is not initialized."$)
|
||||
' Es crucial retornar Null si no está inicializado para que el handler capture el error.
|
||||
Return Null
|
||||
End If
|
||||
' ANTES: Return Main.ConnectionPoolManager1.GetConnection
|
||||
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)
|
||||
Dim newCommands As Map
|
||||
newCommands.Initialize
|
||||
@@ -181,48 +177,45 @@ Private Sub LoadSQLCommands(config2 As Map, DB As String)
|
||||
Main.commandsMap.Put(DB, commands)
|
||||
End Sub
|
||||
|
||||
' ** Delegación de estadísticas de C3P0 a HikariCP **
|
||||
' Delegation of statistics from C3P0 to HikariCP
|
||||
Public Sub GetPoolStats As Map
|
||||
Dim stats As Map
|
||||
stats.Initialize
|
||||
|
||||
If MyHikariPool.IsInitialized Then
|
||||
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
|
||||
Return hikariStats
|
||||
Catch
|
||||
' Fallo en el método GetStats del wrapper.
|
||||
Dim ErrorMsg As String = $"RDCConnector.GetPoolStats: ERROR CRÍTICO al obtener estadísticas de HikariCP: ${LastException.Message}"$
|
||||
' Failure in the wrapper's GetStats method.
|
||||
Dim ErrorMsg As String = $"RDCConnector.GetPoolStats: CRITICAL ERROR getting stats from HikariCP: ${LastException.Message}"$
|
||||
Log(ErrorMsg)
|
||||
stats.Put("Error", LastException.Message)
|
||||
End Try
|
||||
Else
|
||||
stats.Put("Error", "Pool local MyHikariPool no inicializado.")
|
||||
stats.Put("Error", "Local pool MyHikariPool not initialized.")
|
||||
End If
|
||||
|
||||
Return stats
|
||||
End Sub
|
||||
|
||||
' *** NUEVA SUBRUTINA: Cierra el pool de conexiones de forma ordenada ***
|
||||
' Close the connection pool cleanly
|
||||
Public Sub Close
|
||||
If MyHikariPool.IsInitialized Then
|
||||
' Cierre limpio del pool subyacente.
|
||||
' Clean closure of the underlying pool.
|
||||
MyHikariPool.ClosePool
|
||||
Log($"RDCConnector.Close: Pool Hikari cerrado limpiamente para este conector."$)
|
||||
Log($"RDCConnector.Close: Hikari pool closed cleanly for this connector."$)
|
||||
End If
|
||||
' Ya NO delegamos el cierre al Manager.
|
||||
' ANTES: Main.ConnectionPoolManager1.ClosePoolByType(poolType) [15]
|
||||
' La línea de delegación a Main.ConnectionPoolManager1.ClosePoolByType(poolType) ha sido eliminada.
|
||||
End Sub
|
||||
|
||||
' --- SUBRUTINAS DE UTILIDAD PARA CARGA DE PROPIEDADES ---
|
||||
' --- UTILITY SUBROUTINES FOR LOADING PROPERTIES ---
|
||||
|
||||
' [2]
|
||||
Private Sub LoadDriverProperties(driverShortName As String, config_ As Map)
|
||||
driverProperties = ExtractProperties($"driver.${driverShortName.trim}."$, config_, Null, Null)
|
||||
End Sub
|
||||
|
||||
' [3]
|
||||
Private Sub ExtractProperties(prefix As String, input As Map, newPrefix As String, output As Map) As Map
|
||||
Dim properties As Map
|
||||
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
|
||||
If newPrefix.EqualsIgnoreCase(Null) Then newPrefix = ""
|
||||
Dim prefixLength As Int = prefix.Length
|
||||
|
||||
|
||||
' Log($"Prefijo=${prefix}, ${newPrefix}"$)
|
||||
For Each k As String In input.Keys
|
||||
' 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))
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
Return properties
|
||||
End Sub
|
||||
|
||||
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)
|
||||
End Sub
|
||||
End Sub
|
||||
|
||||
451
jRDC_Multi.b4j
451
jRDC_Multi.b4j
@@ -30,26 +30,25 @@ Library7=jshell
|
||||
Library8=json
|
||||
Library9=jsql
|
||||
Module1=Cambios
|
||||
Module10=LoginHandler
|
||||
Module11=LogoutHandler
|
||||
Module12=Manager
|
||||
Module13=ParameterValidationUtils
|
||||
Module14=ping
|
||||
Module15=RDCConnector
|
||||
Module16=SSE
|
||||
Module17=SSEHandler
|
||||
Module18=TestHandler
|
||||
Module10=LogoutHandler
|
||||
Module11=Manager
|
||||
Module12=ParameterValidationUtils
|
||||
Module13=ping
|
||||
Module14=RDCConnector
|
||||
Module15=SSE
|
||||
Module16=SSEHandler
|
||||
Module17=TestHandler
|
||||
Module2=ChangePassHandler
|
||||
Module3=ConnectionPoolManager
|
||||
Module4=DBHandlerB4X
|
||||
Module5=DBHandlerJSON
|
||||
Module6=DoLoginHandler
|
||||
Module7=faviconHandler
|
||||
Module8=GlobalParameters
|
||||
Module9=HikariConnectionPool
|
||||
Module3=DBHandlerB4X
|
||||
Module4=DBHandlerJSON
|
||||
Module5=DoLoginHandler
|
||||
Module6=faviconHandler
|
||||
Module7=GlobalParameters
|
||||
Module8=HikariConnectionPool
|
||||
Module9=LoginHandler
|
||||
NumberOfFiles=9
|
||||
NumberOfLibraries=9
|
||||
NumberOfModules=18
|
||||
NumberOfModules=17
|
||||
Version=10.3
|
||||
@EndOfDesignText@
|
||||
'Non-UI application (console / server application)
|
||||
@@ -95,51 +94,42 @@ Version=10.3
|
||||
Sub Process_Globals
|
||||
' The main B4J HTTP server object
|
||||
Public srvr As Server
|
||||
|
||||
' The current version of this modified jRDC server
|
||||
Public const VERSION As Float = 2.23
|
||||
|
||||
' Custom types for serializing/deserializing data
|
||||
Type DBCommand (Name As String, Parameters() As Object)
|
||||
Type DBResult (Tag As Object, Columns As Map, Rows As List)
|
||||
|
||||
' Holds a list of configured database identifiers (e.g., "DB1", "DB2")
|
||||
Public listaDeCP As List
|
||||
|
||||
' A temporary list to store found configuration file names during startup
|
||||
Private cpFiles As List
|
||||
|
||||
' Global maps to manage database connectors and loaded SQL commands
|
||||
Public Connectors, commandsMap As Map
|
||||
|
||||
' SQL object for interacting with the local users and logs database (SQLite)
|
||||
Public SQL1 As SQL
|
||||
|
||||
' SQL object for interacting with the local users database (Authentication)
|
||||
Public SQL_Auth As SQL ' --- NEW INSTANCE FOR AUTHENTICATION
|
||||
' 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
|
||||
Private bc As BCrypt
|
||||
|
||||
' A Java ReentrantLock object to protect Main.Connectors during Hot-Swapping (thread-safety)
|
||||
Public MainConnectorsLock As JavaObject
|
||||
|
||||
' A Java ReentrantLock object to protect the log caches (QueryLogCache and ErrorLogCache)
|
||||
Public LogCacheLock As JavaObject
|
||||
|
||||
' Timer for executing periodic tasks, such as log cleanup
|
||||
Public timerLogs As Timer
|
||||
|
||||
' Map to store the SQLite logging status (True/False) for each DBKey (DB1, DB2, etc.)
|
||||
Public SQLiteLoggingStatusByDB As Map
|
||||
|
||||
' Global flag indicating if AT LEAST one database has SQLite logging enabled
|
||||
Public IsAnySQLiteLoggingEnabled As Boolean
|
||||
|
||||
' Type to encapsulate the result of parameter validation
|
||||
Type ParameterValidationResult ( _
|
||||
Success As Boolean, _
|
||||
ErrorMessage As String, _
|
||||
ParamsToExecute As List _ ' The final list of parameters to use in the SQL execution
|
||||
)
|
||||
|
||||
' In-memory cache for performance logs (query_logs)
|
||||
Public QueryLogCache As List
|
||||
' In-memory cache for error and warning logs
|
||||
@@ -156,13 +146,11 @@ Sub Process_Globals
|
||||
Private const VACUUM_CYCLES As Int = 48
|
||||
' Granular control for TEXT file logging (CSV)
|
||||
Public TextLoggingStatusByDB As Map
|
||||
' Main object for managing all connection pools (RDCConnector instances)
|
||||
Public ConnectionPoolManager1 As ConnectionPoolManager
|
||||
End Sub
|
||||
|
||||
' --- Main application entry point ---
|
||||
Sub AppStart (Args() As String)
|
||||
|
||||
|
||||
' Initialize Server-Sent Events handler
|
||||
SSE.Initialize
|
||||
' Set logger flag based on build mode (DEBUG or RELEASE)
|
||||
@@ -173,13 +161,13 @@ Sub AppStart (Args() As String)
|
||||
#else
|
||||
logger = False
|
||||
#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
|
||||
CopiarRecursoSiNoExiste("manager.html", "www")
|
||||
CopiarRecursoSiNoExiste("login.html", "www")
|
||||
|
||||
|
||||
' Copy root files (configs, start/stop scripts) if they don't exist
|
||||
CopiarRecursoSiNoExiste("config.properties", "")
|
||||
' CopiarRecursoSiNoExiste("config.DB2.properties", "")
|
||||
@@ -189,16 +177,16 @@ Sub AppStart (Args() As String)
|
||||
CopiarRecursoSiNoExiste("stop.bat", "")
|
||||
CopiarRecursoSiNoExiste("reiniciaProcesoBow.bat", "")
|
||||
CopiarRecursoSiNoExiste("reiniciaProcesoPM2.bat", "")
|
||||
|
||||
|
||||
' Initialize the BCrypt password hashing library
|
||||
bc.Initialize("BC")
|
||||
' Initialize in-memory log caches
|
||||
QueryLogCache.Initialize
|
||||
ErrorLogCache.Initialize
|
||||
|
||||
|
||||
' === 1. Initialize the local user database (SQLite) and log tables ===
|
||||
InitializeSQLiteDatabase
|
||||
|
||||
|
||||
' === 2. Initialize global maps defined in GlobalParameters.bas ===
|
||||
GlobalParameters.mpLogs.Initialize
|
||||
GlobalParameters.mpTotalRequests.Initialize
|
||||
@@ -228,11 +216,8 @@ Sub AppStart (Args() As String)
|
||||
' Initialize the lock for log caches
|
||||
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) ===
|
||||
|
||||
|
||||
Try
|
||||
' Initialize the main 'DB1' connector
|
||||
Dim con1 As RDCConnector
|
||||
@@ -244,19 +229,19 @@ Sub AppStart (Args() As String)
|
||||
' Add 'DB1' to the list of active database keys
|
||||
listaDeCP.Add("DB1")
|
||||
Log($"Main.AppStart: Connector 'DB1' initialized successfully on port: ${srvr.Port}"$)
|
||||
|
||||
|
||||
' Read the 'enableSQLiteLogs' setting from config.properties (default to 0)
|
||||
Dim enableLogsSetting As Int = con1.config.GetDefault("enableSQLiteLogs", 0).As(Int)
|
||||
Dim isEnabled As Boolean = (enableLogsSetting = 1)
|
||||
' Store the status in the granular map
|
||||
SQLiteLoggingStatusByDB.Put("DB1", isEnabled)
|
||||
|
||||
|
||||
' Read the 'enableTextLogging' setting
|
||||
Dim enableTextLogsSetting As Int = con1.config.GetDefault("enableTextLogging", 0).As(Int)
|
||||
Dim isTextEnabled As Boolean = (enableTextLogsSetting = 1)
|
||||
' Store the text log status
|
||||
TextLoggingStatusByDB.Put("DB1", isTextEnabled)
|
||||
|
||||
|
||||
Catch
|
||||
' This is a critical failure; the server cannot start without DB1
|
||||
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
|
||||
ExitApplication
|
||||
End Try
|
||||
|
||||
|
||||
' === 5. DETECTION AND INITIALIZATION OF ADDITIONAL DATABASES (DB2, DB3, DB4) ===
|
||||
|
||||
|
||||
' Scan the application's root directory for configuration files
|
||||
cpFiles = File.ListFiles("./")
|
||||
If cpFiles.Size > 0 Then
|
||||
For Each fileName As String In cpFiles
|
||||
Dim keyPrefix As String = "config."
|
||||
Dim keySuffix As String = ".properties"
|
||||
|
||||
|
||||
' 1. Filter and exclude DB1 (which is already loaded)
|
||||
' Find files matching "config.xxx.properties" but not "config.properties"
|
||||
If fileName.StartsWith(keyPrefix) And fileName.EndsWith(keySuffix) And fileName <> "config.properties" Then
|
||||
|
||||
|
||||
Try
|
||||
' 2. Extract the key ("xxx" from config.xxx.properties)
|
||||
Dim keyLength As Int = fileName.Length - keySuffix.Length
|
||||
Dim dbKey As String = fileName.SubString2(keyPrefix.Length, keyLength)
|
||||
|
||||
|
||||
' ROBUSTNESS: Ensure the key is UPPERCASE for consistency.
|
||||
' Handlers normalize the key to uppercase, so we must match that.
|
||||
dbKey = dbKey.ToUpperCase.Trim
|
||||
|
||||
|
||||
Log($"Main.AppStart: Configuration file detected: '${fileName}'. Initializing connector '${dbKey}'."$)
|
||||
|
||||
Dim newCon As RDCConnector
|
||||
|
||||
|
||||
' 3. Initialize the RDC Connector (which reads its own config.dbKey.properties file)
|
||||
newCon.Initialize(dbKey)
|
||||
|
||||
' 4. Update global structures (Thread-Safe Maps)
|
||||
Connectors.Put(dbKey, newCon)
|
||||
listaDeCP.Add(dbKey)
|
||||
|
||||
|
||||
' 5. Granular Logging Logic
|
||||
' Capture the logging status for this new DB
|
||||
Dim enableLogsSetting As Int = newCon.config.GetDefault("enableSQLiteLogs", 0).As(Int)
|
||||
Dim isEnabled As Boolean = (enableLogsSetting = 1)
|
||||
SQLiteLoggingStatusByDB.Put(dbKey, isEnabled)
|
||||
|
||||
|
||||
' Capture text logging status for this new DB
|
||||
Dim enableTextLogsSetting As Int = newCon.config.GetDefault("enableTextLogging", 0).As(Int)
|
||||
Dim isTextEnabled As Boolean = (enableTextLogsSetting = 1)
|
||||
TextLoggingStatusByDB.Put(dbKey, isTextEnabled)
|
||||
Log("TEXT LOGGING STATUS BY DB: " & TextLoggingStatusByDB)
|
||||
' Note: Global re-evaluation of IsAnySQLiteLoggingEnabled is done at the end of AppStart.
|
||||
|
||||
|
||||
Catch
|
||||
' 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.
|
||||
@@ -323,7 +308,7 @@ Sub AppStart (Args() As String)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
|
||||
|
||||
' Final log of all databases the server is managing.
|
||||
Dim sbListaDeCP_Log As StringBuilder
|
||||
sbListaDeCP_Log.Initialize
|
||||
@@ -336,10 +321,10 @@ Sub AppStart (Args() As String)
|
||||
Log($"Main.AppStart: Configured and ready databases: [${sbListaDeCP_Log.ToString}]"$)
|
||||
|
||||
' <<<< Initialization block for the log cleanup Timer >>>>
|
||||
|
||||
|
||||
' UNCONDITIONAL Initialization of the Timer (Ensures the object exists and prevents IllegalStateException)
|
||||
timerLogs.Initialize("TimerLogs", 1800000) ' 30 minutes = 1800 * 1000 = 1800000 ms
|
||||
|
||||
|
||||
' CONDITIONAL CONTROL BASED ON GRANULAR STATUS
|
||||
IsAnySQLiteLoggingEnabled = False
|
||||
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
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
If IsAnySQLiteLoggingEnabled Then
|
||||
timerLogs.Enabled = True
|
||||
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) ---
|
||||
Sub InitializeSQLiteDatabase
|
||||
Dim dbFileName As String = "users.db"
|
||||
|
||||
' Check if the database file already exists
|
||||
If File.Exists(File.DirApp, dbFileName) = False Then
|
||||
' --- Create a new database ---
|
||||
Log("Creating new user database: " & dbFileName)
|
||||
SQL1.InitializeSQLite(File.DirApp, dbFileName, True)
|
||||
' Create 'users' table
|
||||
Dim createUserTable As String = "CREATE TABLE users (username TEXT PRIMARY KEY, password_hash TEXT NOT NULL)"
|
||||
SQL1.ExecNonQuery(createUserTable)
|
||||
Private dbFileName As String = "users.db"
|
||||
Private dbDirName As String = GlobalParameters.WorkingDirectory
|
||||
|
||||
' --- Configuration for SQL_Logs based on LOG_DB_MODE ---
|
||||
Private logDirName As String = dbDirName
|
||||
Private logFileName As String = dbFileName
|
||||
Private isInMemoryMode As Boolean = (LOG_DB_MODE = "MEMORY")
|
||||
|
||||
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
|
||||
If logger Then Log("Creating 'query_logs' table 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)
|
||||
' Initialize SQL_Auth (always points to the disk file for user persistence).
|
||||
SQL_Auth.InitializeSQLite(dbDirName, dbFileName, True)
|
||||
|
||||
' Initialize SQL_Logs (points to disk file or :memory:)
|
||||
SQL_Logs.InitializeSQLite(logDirName, logFileName, True)
|
||||
|
||||
' Set PRAGMA for better performance (Write-Ahead Logging)
|
||||
SQL1.ExecNonQuery("PRAGMA journal_mode=WAL;")
|
||||
SQL1.ExecNonQuery("PRAGMA synchronous=NORMAL;")
|
||||
' Check if schema creation/migration is necessary.
|
||||
' This is true if the disk file is brand new OR if we are running in memory mode.
|
||||
Private isNewDbFile As Boolean = File.Exists(dbDirName, dbFileName) = False
|
||||
|
||||
' Insert default user
|
||||
Dim defaultUser As String = "admin"
|
||||
Dim defaultPass As String = "admin"
|
||||
Dim hashedPass As String = bc.hashpw(defaultPass, bc.gensalt)
|
||||
SQL1.ExecNonQuery2("INSERT INTO users (username, password_hash) VALUES (?, ?)", Array As Object(defaultUser, hashedPass))
|
||||
Log($"Default user created -> user: ${defaultUser}, pass: ${defaultPass}"$)
|
||||
|
||||
' Create 'errores' (errors) table
|
||||
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)"
|
||||
SQL1.ExecNonQuery(createErrorsTable)
|
||||
|
||||
If logger Then Log("Creating performance indexes on log tables.")
|
||||
|
||||
' Index on timestamp for fast cleanup (DELETE/ORDER BY) in query_logs
|
||||
SQL1.ExecNonQuery("CREATE INDEX idx_query_timestamp ON query_logs(timestamp)")
|
||||
|
||||
' Index on duration_ms for the 'slowqueries' query (ORDER BY)
|
||||
SQL1.ExecNonQuery("CREATE INDEX idx_query_duration ON query_logs(duration_ms)")
|
||||
|
||||
' Index on timestamp for fast cleanup of the errors table
|
||||
SQL1.ExecNonQuery("CREATE INDEX idx_error_timestamp ON errores(timestamp)")
|
||||
If isNewDbFile Or isInMemoryMode Then
|
||||
|
||||
If logger Then Log("Schema creation required (New DB file or In-Memory mode).")
|
||||
|
||||
' 1. TABLE CREATION (Done via SQL_Logs instance, as it handles the schema)
|
||||
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)")
|
||||
SQL_Logs.ExecNonQuery("CREATE TABLE errores (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)
|
||||
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)")
|
||||
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)")
|
||||
|
||||
' 3. PRAGMAS (Applied to both to ensure consistency in WAL mode)
|
||||
SQL_Logs.ExecNonQuery("PRAGMA journal_mode=WAL")
|
||||
SQL_Logs.ExecNonQuery("PRAGMA synchronous=NORMAL")
|
||||
SQL_Auth.ExecNonQuery("PRAGMA journal_mode=WAL")
|
||||
SQL_Auth.ExecNonQuery("PRAGMA synchronous=NORMAL")
|
||||
|
||||
Else
|
||||
' --- Load existing database ---
|
||||
SQL1.InitializeSQLite(File.DirApp, dbFileName, True)
|
||||
Log("User database loaded.")
|
||||
' Ensure WAL mode is set on existing DBs
|
||||
SQL1.ExecNonQuery("PRAGMA journal_mode=WAL;")
|
||||
SQL1.ExecNonQuery("PRAGMA synchronous=NORMAL;")
|
||||
' Load existing database (DISK Mode)
|
||||
If logger Then Log("Existing users.db found. Applying PRAGMAS and checking migrations.")
|
||||
|
||||
' >>> START: Migration logic (ALTER TABLE) if the DB already existed <<<
|
||||
If logger Then Log("Verifying and migrating 'query_logs' table if necessary.")
|
||||
|
||||
' Check if 'query_logs' table exists
|
||||
If SQL1.ExecQuerySingleResult("SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs'") = Null Then
|
||||
|
||||
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' <<<
|
||||
' Ensure PRAGMAS are set on both connections
|
||||
SQL_Logs.ExecNonQuery("PRAGMA journal_mode=WAL")
|
||||
SQL_Logs.ExecNonQuery("PRAGMA synchronous=NORMAL")
|
||||
SQL_Auth.ExecNonQuery("PRAGMA journal_mode=WAL")
|
||||
SQL_Auth.ExecNonQuery("PRAGMA synchronous=NORMAL")
|
||||
|
||||
' >>> 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: Migration logic (ALTER TABLE) <<<
|
||||
|
||||
' (Migration logic for other assumed columns/tables should use SQL_Logs)
|
||||
|
||||
End If
|
||||
End Sub
|
||||
@@ -606,61 +526,55 @@ Public Sub WriteQueryLogsBatch
|
||||
logsToWrite.Initialize ' 1. Initialize the local list (CRITICAL)
|
||||
|
||||
' === STEP 1: Atomic Cache Swap (Protected by ReentrantLock) ===
|
||||
|
||||
LogCacheLock.RunMethod("lock", Null)
|
||||
|
||||
|
||||
If QueryLogCache.Size = 0 Then
|
||||
' Cache is empty, release lock and return
|
||||
LogCacheLock.RunMethod("unlock", Null)
|
||||
Return
|
||||
End If
|
||||
|
||||
|
||||
' *** CRITICAL FIX: Copy content (AddAll) instead of reference. ***
|
||||
logsToWrite.AddAll(QueryLogCache)
|
||||
|
||||
Dim batchSize As Int = logsToWrite.Size
|
||||
|
||||
|
||||
' Clear the global cache. logsToWrite now holds the copy of the items.
|
||||
QueryLogCache.Initialize
|
||||
|
||||
LogCacheLock.RunMethod("unlock", Null)
|
||||
|
||||
|
||||
' Check if text logging is enabled for any of these logs
|
||||
If logsToWrite.Size > 0 Then
|
||||
' 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.
|
||||
CallSubDelayed2(Me, "ArchiveQueryLogsToDailyFile", logsToWrite)
|
||||
End If
|
||||
|
||||
' === STEP 2: Transactional Write to SQLite ===
|
||||
|
||||
' === STEP 2: Transactional Write to SQLite ===
|
||||
Try
|
||||
' 1. Begin the transaction: Everything that follows is a single disk operation.
|
||||
SQL1.BeginTransaction
|
||||
|
||||
' 1. Begin the transaction on the dedicated LOGS instance.
|
||||
SQL_Logs.BeginTransaction
|
||||
|
||||
For Each logEntry As Map In logsToWrite
|
||||
' 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"), _
|
||||
logEntry.Get("client_ip"), logEntry.Get("busy_connections"), logEntry.Get("handler_active_requests"), _
|
||||
logEntry.Get("timestamp_text_local")))
|
||||
logEntry.Get("client_ip"), logEntry.Get("busy_connections"), logEntry.Get("handler_active_requests"), _
|
||||
logEntry.Get("timestamp_text_local")))
|
||||
Next
|
||||
|
||||
|
||||
' 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."$)
|
||||
|
||||
Catch
|
||||
' 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
|
||||
Log(ErrorMsg)
|
||||
|
||||
|
||||
' 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)
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
' --- Event subroutine for the 'timerLogs' Timer. ---
|
||||
@@ -674,7 +588,7 @@ Sub TimerLogs_Tick
|
||||
WriteErrorLogsBatch
|
||||
|
||||
' 3. Clean up and VACUUM (this sub also checks IsAnySQLiteLoggingEnabled)
|
||||
borraArribaDe30000Logs
|
||||
borraArribaDe10000Logs
|
||||
|
||||
Catch
|
||||
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
|
||||
Public Sub WriteErrorLogsBatch
|
||||
' List to store error logs copied from the cache
|
||||
Dim logsToWrite As List
|
||||
logsToWrite.Initialize
|
||||
|
||||
' === STEP 1: Atomic Cache Swap (Protected by ReentrantLock) ===
|
||||
' Bloqueamos el LogCacheLock para garantizar la atomicidad de la copia y limpieza.
|
||||
|
||||
' Lock LogCacheLock to guarantee atomicity of copy and cleanup.
|
||||
LogCacheLock.RunMethod("lock", Null)
|
||||
|
||||
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)
|
||||
Return
|
||||
End If
|
||||
|
||||
' *** Copiar el contenido de la caché global de forma atómica. ***
|
||||
|
||||
' *** Atomically copy global cache content. ***
|
||||
logsToWrite.AddAll(ErrorLogCache)
|
||||
|
||||
' Usar el tamaño de la lista copiada para el procesamiento.
|
||||
|
||||
Dim batchSize As Int = logsToWrite.Size
|
||||
' Log(logsToWrite)
|
||||
|
||||
' Limpiar la caché global. logsToWrite es ahora una lista independiente y poblada.
|
||||
|
||||
' Clean the global cache. logsToWrite is now an independent and populated list.
|
||||
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}"$)
|
||||
|
||||
' === La corrección de Lógica ocurre aquí: La llamada a ArchiveErrorLogsToDailyFile
|
||||
' 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)
|
||||
' === STEP 1: Archive to daily CSV file (if enabled) ===
|
||||
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)
|
||||
End If
|
||||
|
||||
' === STEP 2: Escritura Transaccional a SQLite (Usa logsToWrite) ===
|
||||
|
||||
' === STEP 2: Transactional Write to SQLite (Uses logsToWrite) ===
|
||||
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.")
|
||||
Return
|
||||
End If
|
||||
|
||||
Try
|
||||
' 1. Iniciar la transacción.
|
||||
SQL1.BeginTransaction
|
||||
|
||||
' 1. Start transaction on the dedicated LOGS instance.
|
||||
SQL_Logs.BeginTransaction
|
||||
|
||||
For Each logEntry As Map In logsToWrite
|
||||
' Insertar la entrada de log
|
||||
SQL1.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"), _
|
||||
logEntry.Get("db_key"), logEntry.Get("command_name"), logEntry.Get("client_ip")))
|
||||
' Insert the log entry
|
||||
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"), _
|
||||
logEntry.Get("db_key"), logEntry.Get("command_name"), logEntry.Get("client_ip")))
|
||||
Next
|
||||
|
||||
' 2. Confirmar la transacción.
|
||||
SQL1.TransactionSuccessful
|
||||
|
||||
' 2. Commit the transaction.
|
||||
SQL_Logs.TransactionSuccessful
|
||||
If logger Then Log($"[LOG BATCH] Batch of ${logsToWrite.Size} ERROR logs written successfully."$)
|
||||
|
||||
Catch
|
||||
' 3. Rollback si falla.
|
||||
SQL1.Rollback
|
||||
' 3. Rollback if failed.
|
||||
SQL_Logs.Rollback
|
||||
Dim ErrorMsg As String = "CRITICAL ERROR: Failed to write ERROR log batch to SQLite: " & LastException.Message
|
||||
Log(ErrorMsg)
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
' Deletes the oldest records from 'query_logs' table and runs VACUUM.
|
||||
Sub borraArribaDe30000Logs '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
|
||||
Sub borraArribaDe10000Logs 'ignore
|
||||
|
||||
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)
|
||||
Dim fechaCorteError As Long
|
||||
Try ' OFFSET 15000 skips the 15,000 most recent.
|
||||
fechaCorteError = SQL1.ExecQuerySingleResult($"SELECT timestamp FROM errores ORDER BY timestamp DESC LIMIT 1 OFFSET 15000"$)
|
||||
Catch ' If the table has fewer than 15,000 records, result is NULL.
|
||||
Try ' OFFSET LOG_LIMIT_ERRORS skips the most recent.
|
||||
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.
|
||||
fechaCorteError = 0
|
||||
End Try
|
||||
|
||||
' If a cutoff time was found...
|
||||
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
|
||||
|
||||
|
||||
' 3. Control and Conditional Execution of VACUUM
|
||||
TimerTickCount = TimerTickCount + 1
|
||||
|
||||
If TimerTickCount >= VACUUM_CYCLES Then
|
||||
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.
|
||||
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."$)
|
||||
End If
|
||||
|
||||
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.")
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -8,7 +8,6 @@ ModuleBookmarks14=
|
||||
ModuleBookmarks15=
|
||||
ModuleBookmarks16=
|
||||
ModuleBookmarks17=
|
||||
ModuleBookmarks18=
|
||||
ModuleBookmarks2=
|
||||
ModuleBookmarks3=
|
||||
ModuleBookmarks4=
|
||||
@@ -27,7 +26,6 @@ ModuleBreakpoints14=
|
||||
ModuleBreakpoints15=
|
||||
ModuleBreakpoints16=
|
||||
ModuleBreakpoints17=
|
||||
ModuleBreakpoints18=
|
||||
ModuleBreakpoints2=
|
||||
ModuleBreakpoints3=
|
||||
ModuleBreakpoints4=
|
||||
@@ -42,11 +40,10 @@ ModuleClosedNodes10=
|
||||
ModuleClosedNodes11=
|
||||
ModuleClosedNodes12=
|
||||
ModuleClosedNodes13=
|
||||
ModuleClosedNodes14=
|
||||
ModuleClosedNodes15=
|
||||
ModuleClosedNodes16=5,6
|
||||
ModuleClosedNodes17=2,3
|
||||
ModuleClosedNodes18=
|
||||
ModuleClosedNodes14=2,3,4,6,7
|
||||
ModuleClosedNodes15=5,6
|
||||
ModuleClosedNodes16=2,3
|
||||
ModuleClosedNodes17=
|
||||
ModuleClosedNodes2=
|
||||
ModuleClosedNodes3=
|
||||
ModuleClosedNodes4=
|
||||
@@ -55,6 +52,6 @@ ModuleClosedNodes6=
|
||||
ModuleClosedNodes7=
|
||||
ModuleClosedNodes8=
|
||||
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
|
||||
VisibleModules=4,5,15,1,12,9,3,13
|
||||
VisibleModules=3,4,14,1,11,8,12,5,2
|
||||
|
||||
Reference in New Issue
Block a user