Files
jRDC-MultiDB-Hikari/DBHandlerJSON.bas
jaguerrau 9c9e2975e9 - 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.
2025-10-29 05:25:56 -06:00

301 lines
16 KiB
QBasic

B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
' 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
' 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
' Class initialization subroutine. Called when an object of this class is created.
Public Sub Initialize
' No specific initialization is required for this class at this time.
End Sub
' This is the main method that handles incoming HTTP requests (req) and prepares the response (resp).
Sub Handle(req As ServletRequest, resp As ServletResponse)
' 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.
' OPTIONS requests are CORS pre-flights and should not process business logic or counters.
If req.Method = "OPTIONS" Then
Return ' We exit directly for these requests.
End If
Dim start As Long = DateTime.Now ' Record the request start time to calculate duration.
' 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 ' --- START: Try block wrapping the main Handler logic ---
Dim jsonString As String
' Logic to handle POST requests with JSON in the body
If req.Method = "POST" And req.ContentType.Contains("application/json") Then
' 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) ' 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
' Otherwise, assume the JSON comes in the 'j' parameter of the URL (legacy/GET method).
jsonString = req.GetParameter("j")
End If
' 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)
duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return
End If
Dim parser As JSONParser
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", "") ' Get the execution type (e.g., "ExecuteQuery").
' 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") ' Get the list of parameters for the query.
If paramsList = Null Or paramsList.IsInitialized = False Then
paramsList.Initialize ' If no parameters, initialize an empty list.
End If
' 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")
' --- 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 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
' --- END: Active request count ---
' Initialize the Connector with the resolved finalDbKey.
Connector = Main.Connectors.Get(finalDbKey)
' 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)
duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return
End If
con = Connector.GetConnection(finalDbKey) ' The DB connection is obtained here from the connection pool!
' 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
' Ensure the value is Int!
poolBusyConnectionsForLog = poolStats.Get("BusyConnections").As(Int) ' We capture the value.
' Log($">>>>>>>>>> ${poolStats.Get("BusyConnections")} "$)
End If
End If
Dim cachedStatsJSON As Map = Main.LatestPoolStats.Get(finalDbKey).As(Map)
If cachedStatsJSON.IsInitialized Then
' Values were already captured: poolBusyConnectionsForLog and requestsBeforeDecrement
cachedStatsJSON.Put("BusyConnections", poolBusyConnectionsForLog)
cachedStatsJSON.Put("HandlerActiveRequests", requestsBeforeDecrement)
If poolStats.ContainsKey("TotalConnections") Then
cachedStatsJSON.Put("TotalConnections", poolStats.Get("TotalConnections"))
End If
If poolStats.ContainsKey("IdleConnections") Then
cachedStatsJSON.Put("IdleConnections", poolStats.Get("IdleConnections"))
End If
' 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}"$)
' Get the SQL statement corresponding to the command name from config.properties.
Dim sqlCommand As String = Connector.GetCommand(finalDbKey, queryNameForLog)
' 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)
SendErrorResponse(resp, 400, errorMessage)
duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return
End If
' Logic to execute different command types based on the 'execType' parameter
If execType.ToLowerCase = "executequery" Then
' --- 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 ' Early exit.
End If
Dim rs As ResultSet
' Execute the SQL query with the validated parameter list.
rs = con.ExecQuery2(sqlCommand, validationResult.ParamsToExecute)
' --- END CENTRALIZED PARAMETER VALIDATION ---
Dim ResultList As List
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 ' Iterate over each row in the result.
Dim RowMap As Map
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) ' Add the row map to the results list.
Loop
rs.Close ' Close the ResultSet.
SendSuccessResponse(resp, CreateMap("result": ResultList)) ' Send the success JSON response.
Else If execType.ToLowerCase = "executecommand" Then
' --- 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 ' Early exit.
End If
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)
' Flow continues to final cleanup if there is no explicit Return.
End If
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 ---
' --- 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
' --- 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)
' 1. Call the centralized subroutine in Main to log performance to SQLite.
Main.LogQueryPerformance(qName, durMs, dbKey, clientIp, handlerReqs, poolBusyConns)
' 2. Robustly decrement the active request counter for this dbKey.
Dim currentCount As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey, 0).As(Int)
If currentCount > 0 Then
' If the counter is positive, decrement it.
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, currentCount - 1)
Else
' 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
' 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
' --- Helper subroutines for JSON responses ---
' 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)
' Add the "success": true field to the data map to indicate everything went well.
dataMap.Put("success", True)
' Create a JSON generator.
Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(dataMap)
' Set the response content type to "application/json".
resp.ContentType = "application/json"
' Write the generated JSON string to the HTTP response body.
resp.Write(jsonGenerator.ToString)
End Sub
' 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)
' 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
' Create a map with the error status and message.
Dim resMap As Map = CreateMap("success": False, "error": errorMessage)
' Generate the JSON string from the map.
Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(resMap)
' Set the HTTP status code (e.g., 400 for client error, 500 for server error).
resp.Status = statusCode
' Set the content type and write the error response.
resp.ContentType = "application/json"
resp.Write(jsonGenerator.ToString)
End Sub