diff --git a/Cambios.bas b/Cambios.bas index ae2f589..364d906 100644 --- a/Cambios.bas +++ b/Cambios.bas @@ -26,6 +26,16 @@ Sub Process_Globals ' - Que en el reporte de "Queries lentos" se pueda especificar de cuanto tiempo, ahorita esta de la ultima hora, pero que se pueda seleccionar desde una ' lista, por ejemplo 15, 30, 45 y 60 minutos antes. + ' - VERSION 5.09.17 + + ' - fix(handlers, logs): Reporte robusto de AffectedRows (simbólico) y limpieza de tabla de errores + ' - Aborda dos problemas críticos para la estabilidad y fiabilidad del servidor: el manejo del conteo de filas afectadas en DMLs y la gestión del crecimiento de la tabla de logs de errores. + + ' - Cambios Principales: + + ' 1. Fix AffectedRows (ExecuteBatch V1 y DBHandlerJSON): Dada la imposibilidad de capturar el conteo de filas afectadas real (Null) de forma segura o la falla total en tiempo de ejecución (Method: ExecNonQuery2 not matched) al usar reflexión, se revierte la lógica a la llamada directa de ExecNonQuery2. Si el comando DML se ejecuta sin lanzar una excepción SQL, se reporta simbólicamente '1' fila afectada al cliente (en el Protocolo V1 y en la respuesta JSON para executecommand) para confirmar el éxito de la operación. + ' 2. Limpieza de Tabla de Errores: Se corrigió la subrutina Main.borraArribaDe15000Logs para incluir la tabla `errores` en la limpieza periódica. Esto asegura que el log de errores no crezca indefinidamente, manteniendo solo los 15,000 registros más recientes y realizando la optimización de espacio en disco con `vacuum`. + ' - VERSION 5.09.16.2 ' - feat(logs): Implementación de Cacheo y Escritura Transaccional en Lotes ' diff --git a/DBHandlerB4X.bas b/DBHandlerB4X.bas index c0d370d..f7d804b 100644 --- a/DBHandlerB4X.bas +++ b/DBHandlerB4X.bas @@ -17,15 +17,15 @@ Sub Class_Globals ' La siguiente sección de constantes y utilidades se compila condicionalmente ' solo si la directiva #if VERSION1 está activa. Esto es para dar soporte ' a una versión antigua del protocolo de comunicación de DBRequestManager. -' #if VERSION1 + ' #if VERSION1 ' Constantes para identificar los tipos de datos en la serialización personalizada (protocolo V1). - Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _ + Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _ ,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte ' Utilidades para convertir entre tipos de datos y arrays de bytes. - Private bc As ByteConverter + Private bc As ByteConverter ' Utilidad para comprimir/descomprimir streams de datos (usado en V1). - Private cs As CompressedStreams -' #end if + Private cs As CompressedStreams + ' #end if ' Mapa para convertir tipos de columna JDBC de fecha/hora a los nombres de métodos de Java ' para obtener los valores correctos de ResultSet. @@ -128,25 +128,25 @@ Sub Handle(req As ServletRequest, resp As ServletResponse) CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) Return ' Salida temprana si hay un error. End If -' #if VERSION1 + ' #if VERSION1 ' Estas ramas se compilan solo si #if VERSION1 está activo (para protocolo antiguo). - Else if method = "query" Then - in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1. - q = ExecuteQuery(dbKey, con, in, resp) - If q = "error" Then - duration = DateTime.Now - start - CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) - Return - End If - Else if method = "batch" Then - in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1. - q = ExecuteBatch(dbKey, con, in, resp) - If q = "error" Then - duration = DateTime.Now - start - CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) - Return - End If -' #end if + Else if method = "query" Then + in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1. + q = ExecuteQuery(dbKey, con, in, resp) + If q = "error" Then + duration = DateTime.Now - start + CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) + Return + End If + Else if method = "batch" Then + in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1. + q = ExecuteBatch(dbKey, con, in, resp) + If q = "error" Then + duration = DateTime.Now - start + CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) + Return + End If + ' #end if Else if method = "batch2" Then ' Ejecuta un lote de comandos (INSERT, UPDATE, DELETE) utilizando el protocolo V2. q = ExecuteBatch2(dbKey, con, in, resp) @@ -427,34 +427,41 @@ End Sub ' Ejecuta un lote de comandos usando el protocolo V1. Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String - ' Lee y descarta la versión del cliente. - Dim clientVersion As Float = ReadObject(in) 'ignore - ' Lee cuántos comandos vienen en el lote. - Dim numberOfStatements As Int = ReadInt(in) - Dim res(numberOfStatements) As Int ' Array para resultados (aunque no se usa). + Log($"ExecuteBatch ${DB}"$) + ' Lee y descarta la versión del cliente. + Dim clientVersion As Float = ReadObject(in) 'ignore + ' Lee cuántos comandos vienen en el lote. + Dim numberOfStatements As Int = ReadInt(in) + Dim res(numberOfStatements) As Int ' Array para resultados (aunque no se usa). Dim singleQueryName As String = "" + Dim affectedCounts As List + Dim totalAffectedRows As Int + affectedCounts.Initialize - Try - con.BeginTransaction - ' Itera para procesar cada comando del lote. - For i = 0 To numberOfStatements - 1 - ' Lee el nombre del comando y la lista de parámetros usando el deserializador V1. - Dim queryName As String = ReadObject(in) - Dim params As List = ReadList(in) + Try + con.BeginTransaction + ' Itera para procesar cada comando del lote. + Log(numberOfStatements) + For i = 0 To numberOfStatements - 1 + Log($"i: ${i}"$) + ' Lee el nombre del comando y la lista de parámetros usando el deserializador V1. + Dim queryName As String = ReadObject(in) + Dim params As List = ReadList(in) + Log(params) If numberOfStatements = 1 Then singleQueryName = queryName 'Capturamos el nombre del query. End If - Dim sqlCommand As String = Connector.GetCommand(DB, queryName) - - ' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>> - If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then - con.Rollback ' Deshace la transacción si un comando es inválido. - Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$ - Log(errorMessage) + Dim sqlCommand As String = Connector.GetCommand(DB, queryName) + Log(sqlCommand) + ' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>> + If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then + con.Rollback ' Deshace la transacción si un comando es inválido. + Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$ + Log(errorMessage) Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", errorMessage, DB, queryName, Null) - SendPlainTextError(resp, 400, errorMessage) - Return "error" - End If + SendPlainTextError(resp, 400, errorMessage) + Return "error" + End If ' <<< FIN NUEVA VALIDACIÓN >>> ' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH (V1) >>> @@ -465,29 +472,39 @@ Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As Se SendPlainTextError(resp, 400, validationResult.ErrorMessage) Return "error" ' Salida temprana si la validación falla. End If + + Log(validationResult.ParamsToExecute) + + Dim affectedCount As Int = 1 ' Asumimos éxito (1) ya que la llamada directa es la única que ejecuta el SQL sin fallar en runtime. con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Ejecuta el comando con la lista de parámetros validada. ' <<< FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH (V1) >>> - Next + affectedCounts.Add(affectedCount) ' Añadimos el resultado (1) a la lista de respuesta V1 + totalAffectedRows = totalAffectedRows + affectedCount ' Acumulamos el total para el log (aunque sea 1 simbólico) + + Next - con.TransactionSuccessful ' Confirma la transacción. + con.TransactionSuccessful ' Confirma la transacción. + + Log("Transaction succesfull") - Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip") ' Comprime la salida antes de enviarla. - ' Escribe la respuesta usando el serializador V1. - WriteObject(Main.VERSION, out) - WriteObject("batch", out) - WriteInt(res.Length, out) - For Each r As Int In res - WriteInt(r, out) - Next - out.Close + Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip") ' Comprime la salida antes de enviarla. + ' Escribe la respuesta usando el serializador V1. + WriteObject(Main.VERSION, out) + WriteObject("batch", out) + WriteInt(res.Length, out) + Log(affectedCounts.Size) + For Each r As Int In affectedCounts + WriteInt(r, out) + Next + out.Close - Catch - con.Rollback - Log(LastException) + Catch + con.Rollback + Log(LastException) Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", LastException.Message, DB, "batch_execution_error_v1", Null) - SendPlainTextError(resp, 500, LastException.Message) - End Try + SendPlainTextError(resp, 500, LastException.Message) + End Try ' Return $"batch (size=${numberOfStatements})"$ If numberOfStatements = 1 And singleQueryName <> "" Then @@ -499,24 +516,24 @@ End Sub ' Ejecuta una consulta única usando el protocolo V1. Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String -' Log("====================== ExecuteQuery =====================") - ' Deserializa los datos de la petición usando el protocolo V1. - Dim clientVersion As Float = ReadObject(in) 'ignore - Dim queryName As String = ReadObject(in) - Dim limit As Int = ReadInt(in) - Dim params As List = ReadList(in) + ' Log("====================== ExecuteQuery =====================") + ' Deserializa los datos de la petición usando el protocolo V1. + Dim clientVersion As Float = ReadObject(in) 'ignore + Dim queryName As String = ReadObject(in) + Dim limit As Int = ReadInt(in) + Dim params As List = ReadList(in) - ' Obtiene la sentencia SQL. - Dim theSql As String = Connector.GetCommand(DB, queryName) + ' Obtiene la sentencia SQL. + Dim theSql As String = Connector.GetCommand(DB, queryName) - ' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>> - If theSql = Null Or theSql ="null" Or theSql.Trim = "" Then - Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$ - Log(errorMessage) + ' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>> + If theSql = Null Or theSql ="null" Or theSql.Trim = "" Then + Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$ + Log(errorMessage) Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteQuery (V1)", errorMessage, DB, queryName, Null) - SendPlainTextError(resp, 400, errorMessage) - Return "error" - End If + SendPlainTextError(resp, 400, errorMessage) + Return "error" + End If ' <<< FIN NUEVA VALIDACIÓN >>> ' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA (V1) >>> @@ -531,177 +548,177 @@ Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As Se Dim rs As ResultSet = con.ExecQuery2(theSql, validationResult.ParamsToExecute) ' <<< FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA (V1) >>> - If limit <= 0 Then limit = 0x7fffffff 'max int + If limit <= 0 Then limit = 0x7fffffff 'max int - Dim jrs As JavaObject = rs - Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) - Dim cols As Int = rs.ColumnCount + Dim jrs As JavaObject = rs + Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) + Dim cols As Int = rs.ColumnCount - Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip") ' Comprime el stream de salida. + Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip") ' Comprime el stream de salida. - ' Escribe la cabecera de la respuesta V1. - WriteObject(Main.VERSION, out) - WriteObject("query", out) - WriteInt(rs.ColumnCount, out) + ' Escribe la cabecera de la respuesta V1. + WriteObject(Main.VERSION, out) + WriteObject("query", out) + WriteInt(rs.ColumnCount, out) - ' Escribe los nombres de las columnas. - For i = 0 To cols - 1 - WriteObject(rs.GetColumnName(i), out) - Next + ' Escribe los nombres de las columnas. + For i = 0 To cols - 1 + WriteObject(rs.GetColumnName(i), out) + Next - ' Itera sobre las filas del resultado. - Do While rs.NextRow And limit > 0 - WriteByte(1, out) ' Escribe un byte '1' para indicar que viene una fila. - ' Itera sobre las columnas de la fila. - For i = 0 To cols - 1 - Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1)) - ' Maneja los tipos de datos binarios de forma especial. - If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then - WriteObject(rs.GetBlob2(i), out) - Else - ' Escribe el valor de la columna. - WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out) - End If - Next - limit = limit - 1 - Loop + ' Itera sobre las filas del resultado. + Do While rs.NextRow And limit > 0 + WriteByte(1, out) ' Escribe un byte '1' para indicar que viene una fila. + ' Itera sobre las columnas de la fila. + For i = 0 To cols - 1 + Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1)) + ' Maneja los tipos de datos binarios de forma especial. + If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then + WriteObject(rs.GetBlob2(i), out) + Else + ' Escribe el valor de la columna. + WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out) + End If + Next + limit = limit - 1 + Loop - ' Escribe un byte '0' para indicar el fin de las filas. - WriteByte(0, out) - out.Close - rs.Close + ' Escribe un byte '0' para indicar el fin de las filas. + WriteByte(0, out) + out.Close + rs.Close - Return "query: " & queryName + Return "query: " & queryName End Sub ' Escribe un único byte en el stream de salida. Private Sub WriteByte(value As Byte, out As OutputStream) - out.WriteBytes(Array As Byte(value), 0, 1) + out.WriteBytes(Array As Byte(value), 0, 1) End Sub ' Serializador principal para el protocolo V1. Escribe un objeto al stream. Private Sub WriteObject(o As Object, out As OutputStream) - Dim data() As Byte - ' Escribe un byte de tipo seguido de los datos. - If o = Null Then - out.WriteBytes(Array As Byte(T_NULL), 0, 1) - Else If o Is Short Then - out.WriteBytes(Array As Byte(T_SHORT), 0, 1) - data = bc.ShortsToBytes(Array As Short(o)) - Else If o Is Int Then - out.WriteBytes(Array As Byte(T_INT), 0, 1) - data = bc.IntsToBytes(Array As Int(o)) - Else If o Is Float Then - out.WriteBytes(Array As Byte(T_FLOAT), 0, 1) - data = bc.FloatsToBytes(Array As Float(o)) - Else If o Is Double Then - out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1) - data = bc.DoublesToBytes(Array As Double(o)) - Else If o Is Long Then - out.WriteBytes(Array As Byte(T_LONG), 0, 1) - data = bc.LongsToBytes(Array As Long(o)) - Else If o Is Boolean Then - out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1) - Dim b As Boolean = o - Dim data(1) As Byte - If b Then data(0) = 1 Else data(0) = 0 - Else If GetType(o) = "[B" Then ' Si el objeto es un array de bytes (BLOB) - data = o - out.WriteBytes(Array As Byte(T_BLOB), 0, 1) - ' Escribe la longitud de los datos antes de los datos mismos. - WriteInt(data.Length, out) - Else ' Trata todo lo demás como un String - out.WriteBytes(Array As Byte(T_STRING), 0, 1) - data = bc.StringToBytes(o, "UTF8") - ' Escribe la longitud del string antes del string. - WriteInt(data.Length, out) - End If - ' Escribe los bytes del dato. - If data.Length > 0 Then out.WriteBytes(data, 0, data.Length) + Dim data() As Byte + ' Escribe un byte de tipo seguido de los datos. + If o = Null Then + out.WriteBytes(Array As Byte(T_NULL), 0, 1) + Else If o Is Short Then + out.WriteBytes(Array As Byte(T_SHORT), 0, 1) + data = bc.ShortsToBytes(Array As Short(o)) + Else If o Is Int Then + out.WriteBytes(Array As Byte(T_INT), 0, 1) + data = bc.IntsToBytes(Array As Int(o)) + Else If o Is Float Then + out.WriteBytes(Array As Byte(T_FLOAT), 0, 1) + data = bc.FloatsToBytes(Array As Float(o)) + Else If o Is Double Then + out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1) + data = bc.DoublesToBytes(Array As Double(o)) + Else If o Is Long Then + out.WriteBytes(Array As Byte(T_LONG), 0, 1) + data = bc.LongsToBytes(Array As Long(o)) + Else If o Is Boolean Then + out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1) + Dim b As Boolean = o + Dim data(1) As Byte + If b Then data(0) = 1 Else data(0) = 0 + Else If GetType(o) = "[B" Then ' Si el objeto es un array de bytes (BLOB) + data = o + out.WriteBytes(Array As Byte(T_BLOB), 0, 1) + ' Escribe la longitud de los datos antes de los datos mismos. + WriteInt(data.Length, out) + Else ' Trata todo lo demás como un String + out.WriteBytes(Array As Byte(T_STRING), 0, 1) + data = bc.StringToBytes(o, "UTF8") + ' Escribe la longitud del string antes del string. + WriteInt(data.Length, out) + End If + ' Escribe los bytes del dato. + If data.Length > 0 Then out.WriteBytes(data, 0, data.Length) End Sub ' Deserializador principal para el protocolo V1. Lee un objeto del stream. Private Sub ReadObject(In As InputStream) As Object - ' Lee el primer byte para determinar el tipo de dato. - Dim data(1) As Byte - In.ReadBytes(data, 0, 1) - Select data(0) - Case T_NULL - Return Null - Case T_SHORT - Dim data(2) As Byte - Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0) - Case T_INT - Dim data(4) As Byte - Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0) - Case T_LONG - Dim data(8) As Byte - Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0) - Case T_FLOAT - Dim data(4) As Byte - Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0) - Case T_DOUBLE - Dim data(8) As Byte - Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0) - Case T_BOOLEAN - Dim b As Byte = ReadByte(In) - Return b = 1 - Case T_BLOB - ' Lee la longitud, luego lee esa cantidad de bytes. - Dim len As Int = ReadInt(In) - Dim data(len) As Byte - Return ReadBytesFully(In, data, data.Length) - Case Else ' T_STRING - ' Lee la longitud, luego lee esa cantidad de bytes y los convierte a string. - Dim len As Int = ReadInt(In) - Dim data(len) As Byte - ReadBytesFully(In, data, data.Length) - Return BytesToString(data, 0, data.Length, "UTF8") - End Select + ' Lee el primer byte para determinar el tipo de dato. + Dim data(1) As Byte + In.ReadBytes(data, 0, 1) + Select data(0) + Case T_NULL + Return Null + Case T_SHORT + Dim data(2) As Byte + Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0) + Case T_INT + Dim data(4) As Byte + Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0) + Case T_LONG + Dim data(8) As Byte + Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0) + Case T_FLOAT + Dim data(4) As Byte + Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0) + Case T_DOUBLE + Dim data(8) As Byte + Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0) + Case T_BOOLEAN + Dim b As Byte = ReadByte(In) + Return b = 1 + Case T_BLOB + ' Lee la longitud, luego lee esa cantidad de bytes. + Dim len As Int = ReadInt(In) + Dim data(len) As Byte + Return ReadBytesFully(In, data, data.Length) + Case Else ' T_STRING + ' Lee la longitud, luego lee esa cantidad de bytes y los convierte a string. + Dim len As Int = ReadInt(In) + Dim data(len) As Byte + ReadBytesFully(In, data, data.Length) + Return BytesToString(data, 0, data.Length, "UTF8") + End Select End Sub ' Se asegura de leer exactamente la cantidad de bytes solicitada del stream. Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte() - Dim count = 0, Read As Int - ' Sigue leyendo en un bucle hasta llenar el buffer, por si los datos llegan en partes. - Do While count < Len And Read > -1 - Read = In.ReadBytes(Data, count, Len - count) - count = count + Read - Loop - Return Data + Dim count = 0, Read As Int + ' Sigue leyendo en un bucle hasta llenar el buffer, por si los datos llegan en partes. + Do While count < Len And Read > -1 + Read = In.ReadBytes(Data, count, Len - count) + count = count + Read + Loop + Return Data End Sub ' Escribe un entero (4 bytes) en el stream. Private Sub WriteInt(i As Int, out As OutputStream) - Dim data() As Byte - data = bc.IntsToBytes(Array As Int(i)) - out.WriteBytes(data, 0, data.Length) + Dim data() As Byte + data = bc.IntsToBytes(Array As Int(i)) + out.WriteBytes(data, 0, data.Length) End Sub ' Lee un entero (4 bytes) del stream. Private Sub ReadInt(In As InputStream) As Int - Dim data(4) As Byte - Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0) + Dim data(4) As Byte + Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0) End Sub ' Lee un solo byte del stream. Private Sub ReadByte(In As InputStream) As Byte - Dim data(1) As Byte - In.ReadBytes(data, 0, 1) - Return data(0) + Dim data(1) As Byte + In.ReadBytes(data, 0, 1) + Return data(0) End Sub ' Lee una lista de objetos del stream (protocolo V1). Private Sub ReadList(in As InputStream) As List - ' Primero lee la cantidad de elementos en la lista. - Dim len As Int = ReadInt(in) - Dim l1 As List - l1.Initialize - ' Luego lee cada objeto uno por uno y lo añade a la lista. - For i = 0 To len - 1 - l1.Add(ReadObject(in)) - Next - Return l1 + ' Primero lee la cantidad de elementos en la lista. + Dim len As Int = ReadInt(in) + Dim l1 As List + l1.Initialize + ' Luego lee cada objeto uno por uno y lo añade a la lista. + For i = 0 To len - 1 + l1.Add(ReadObject(in)) + Next + Return l1 End Sub '#end If ' Fin del bloque de compilación condicional para VERSION1 diff --git a/DBHandlerJSON.bas b/DBHandlerJSON.bas index 6bd3f3a..0dce2de 100644 --- a/DBHandlerJSON.bas +++ b/DBHandlerJSON.bas @@ -44,6 +44,7 @@ Sub Handle(req As ServletRequest, resp As ServletResponse) 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. + Dim Total As Int = 0 Try ' --- INICIO: Bloque Try que envuelve la lógica principal del Handler --- @@ -191,9 +192,9 @@ Sub Handle(req As ServletRequest, resp As ServletResponse) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) Return ' Salida temprana. 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("message": "Command executed successfully")) ' Envía confirmación de éxito. + SendSuccessResponse(resp, CreateMap("affectedRows": affectedCount, "message": "Command executed successfully")) ' Envía confirmación de éxito. ' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA --- Else Dim ErrorMsg As String = "Parámetro 'exec' inválido. '" & execType & "' no es un valor permitido." @@ -201,7 +202,6 @@ Sub Handle(req As ServletRequest, resp As ServletResponse) 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. 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 @@ -215,7 +215,6 @@ Sub Handle(req As ServletRequest, resp As ServletResponse) 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. CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) - End Sub ' --- NUEVA SUBRUTINA: Centraliza el logging de rendimiento y la limpieza de recursos --- diff --git a/Manager.bas b/Manager.bas index e4d12bc..4a99896 100644 --- a/Manager.bas +++ b/Manager.bas @@ -2,7 +2,7 @@ Group=Default Group ModulesStructureVersion=1 Type=Class -Version=8.8 +Version=10.3 @EndOfDesignText@ ' Módulo de clase: Manager ' Este handler proporciona un panel de administración web para el servidor jRDC2-Multi. @@ -24,398 +24,291 @@ End Sub ' Método principal que maneja las peticiones HTTP para el panel de administración. ' req: El objeto ServletRequest que contiene la información de la petición entrante. ' resp: El objeto ServletResponse para construir y enviar la respuesta al cliente. +' Módulo de clase: Manager +' ... (tu código de Class_Globals e Initialize se queda igual) ... + +' Método principal que maneja las peticiones HTTP para el panel de administración. +' Refactorizado para funcionar como una API con un frontend estático. Sub Handle(req As ServletRequest, resp As ServletResponse) - ' --- 1. Bloque de Seguridad: Autenticación de Usuario --- - ' Verifica si el usuario actual ha iniciado sesión y está autorizado. - ' Si no está autorizado, se le redirige a la página de login. + ' --- 1. Bloque de Seguridad (sin cambios) --- If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then resp.SendRedirect("/login") - Return ' Termina la ejecución si no está autorizado. + Return End If - ' Obtiene el comando solicitado de los parámetros de la URL (ej. "?command=reload"). Dim Command As String = req.GetParameter("command") - If Command = "" Then Command = "ping" ' Si no se especifica un comando, por defecto es "ping". - Log($"Command: ${Command}"$) - - ' --- MANEJO ESPECIAL PARA SNAPSHOT --- - ' El comando "snapshot" no devuelve HTML, sino una imagen. Lo manejamos por separado al principio. - If Command = "snapshot" Then -' Try -' resp.ContentType = "image/png" -' Dim robot, toolkit As JavaObject -' robot.InitializeNewInstance("java.awt.Robot", Null) -' toolkit.InitializeStatic("java.awt.Toolkit") -' Dim screenRect As JavaObject -' screenRect.InitializeNewInstance("java.awt.Rectangle", Array As Object( _ - ' toolkit.RunMethodJO("getDefaultToolkit", Null).RunMethod("getScreenSize", Null))) -' Dim image As JavaObject = robot.RunMethod("createScreenCapture", Array As Object(screenRect)) -' Dim ImageIO As JavaObject -' ImageIO.InitializeStatic("javax.imageio.ImageIO").RunMethod("write", Array As Object(image, "png", resp.OutputStream)) -' Catch -' resp.SendError(500, LastException.Message) -' End Try -' Return ' Detenemos la ejecución aquí para no enviar más HTML. + ' --- 2. Servidor de la Página Principal --- + ' Si NO se especifica un comando, servimos la página principal del manager desde la carpeta 'www'. + If Command = "" Then + Try + resp.ContentType = "text/html; charset=utf-8" + resp.Write(File.ReadString(File.DirApp, "www/manager.html")) + Catch + resp.SendError(500, "Error: No se pudo encontrar el archivo principal del panel (www/manager.html). " & LastException.Message) + End Try + Return End If - ' --- FIN DE MANEJO ESPECIAL --- - - ' Para todos los demás comandos, construimos la página HTML de respuesta. - resp.ContentType = "text/html" ' Establece el tipo de contenido como HTML. - Dim sb As StringBuilder ' Usamos StringBuilder para construir eficientemente el HTML. - sb.Initialize - - ' --- Estilos y JavaScript (igual que antes) --- - sb.Append("") - sb.Append("") - sb.Append("") - - ' --- Cabecera de la Página y Mensaje de Bienvenida --- - sb.Append("

Panel de Administración jRDC

") - sb.Append($"

Bienvenido, ${req.GetSession.GetAttribute("username")}

"$) - - ' --- Menú de Navegación del Manager --- - ' Este menú incluye las opciones para interactuar con el servidor. - sb.Append("
") - sb.Append("Test | ") - sb.Append("Ping | ") - sb.Append("Reload | ") - sb.Append("Queries Lentas | ") ' Nuevo enlace para queries lentas. - sb.Append("Estadísticas Pool | ") ' Nuevo enlace para estadísticas del pool. - sb.Append("Reiniciar (pm2) | ") - sb.Append("Revive Bow") - sb.Append("
") - sb.Append("
") - - sb.Append("") - - ' --- Resultado del Comando --- - sb.Append("

Resultado del Comando: '" & Command & "'

") - sb.Append("
") - - ' ========================================================================= - ' ### INICIO DE TU LÓGICA DE COMANDOS INTEGRADA ### - ' ========================================================================= - If Command = "reload" Then - - Dim sbTemp As StringBuilder - sbTemp.Initialize - sbTemp.Append($"Iniciando recarga de configuración (Hot-Swap) ($DateTime{DateTime.Now})"$).Append(" " & CRLF) - ' <<< PASO CLAVE 1: DETENER TIMER DE LOGS (ZONA SEGURA DE SQLite) >>> - ' Detenemos el timer incondicionalmente al inicio para evitar conflictos de bloqueo con SQLite - ' durante la inicialización de conectores. - Dim oldTimerState As Boolean = Main.timerLogs.Enabled - If oldTimerState Then - Main.timerLogs.Enabled = False - sbTemp.Append(" -> Timer de limpieza de logs (SQLite) detenido temporalmente.").Append(" " & CRLF) - End If + ' --- 3. Manejo de Comandos como API --- + ' La variable 'j' (JSONGenerator) está en Class_Globals - ' 1. Crear un nuevo mapa temporal para almacenar los conectores recién inicializados. - Dim newConnectors As Map - newConnectors.Initialize - - Dim oldConnectors As Map - Dim reloadSuccessful As Boolean = True - - ' *** INICIO DEL BLOQUE CRÍTICO 1: Obtener oldConnectors con ReentrantLock *** - Dim lock1Acquired As Boolean = False - Try - Main.MainConnectorsLock.RunMethod("lock", Null) - lock1Acquired = True - oldConnectors = Main.Connectors - Catch - sbTemp.Append($" -> ERROR CRÍTICO: No se pudo adquirir el bloqueo para leer conectores antiguos: ${LastException.Message}"$).Append(" " & CRLF) - reloadSuccessful = False - End Try - - If lock1Acquired Then - Main.MainConnectorsLock.RunMethod("unlock", Null) - End If - - If Not(reloadSuccessful) Then - ' Si el bloqueo inicial falló, restauramos el Timer al estado anterior y salimos. - If oldTimerState Then Main.timerLogs.Enabled = True - sb.Append(sbTemp.ToString) - sb.Append($"¡ERROR: La recarga de configuración falló en la fase de bloqueo inicial! Los conectores antiguos siguen activos."$).Append(" " & CRLF) - Return - End If - - ' 2. Iterar sobre las bases de datos configuradas y crear *nuevas* instancias de RDCConnector. - For Each dbKey As String In Main.listaDeCP - - Try - Dim newRDC As RDCConnector - newRDC.Initialize(dbKey) ' Inicializa la nueva instancia con la configuración fresca. - - ' <<< PASO CLAVE 2: LEER Y ALMACENAR EL NUEVO ESTADO DE LOGS PARA CADA DB >>> - ' Leemos la configuración 'enableSQLiteLogs' de esta DBkey. - Dim enableLogsSetting As Int = newRDC.config.GetDefault("enableSQLiteLogs", 0).As(Int) - Dim isEnabled As Boolean = (enableLogsSetting = 1) - - ' Almacenamos el estado temporalmente en el mapa newConnectors bajo una clave única. - newConnectors.Put(dbKey & "_LOG_STATE", isEnabled) - sbTemp.Append($" -> Logs de ${dbKey} activados: ${isEnabled}"$).Append(" " & CRLF) - ' <<< FIN PASO CLAVE 2 >>> - - newConnectors.Put(dbKey, newRDC) - - Dim newPoolStats As Map = newRDC.GetPoolStats - sbTemp.Append($" -> ${dbKey}: Nuevo conector inicializado. Conexiones: ${newPoolStats.Get("TotalConnections")}"$).Append(" " & CRLF) - - Catch - sbTemp.Append($" -> ERROR CRÍTICO al inicializar nuevo conector para ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF) - reloadSuccessful = False - Exit ' Si uno falla, abortamos la recarga. - End Try - - Next - - sb.Append(sbTemp.ToString) - - If reloadSuccessful Then + Select Command.ToLowerCase - ' 3. Si todo fue exitoso, hacemos el Hot-Swap atómico. - ' *** INICIO DEL BLOQUE CRÍTICO 2: Reemplazar Main.Connectors con ReentrantLock *** - - Dim lock2Acquired As Boolean = False - Try - Main.MainConnectorsLock.RunMethod("lock", Null) - lock2Acquired = True - Main.Connectors = newConnectors ' Reemplazamos el mapa de conectores completo por el nuevo. - Catch - sb.Append($" -> ERROR CRÍTICO: No se pudo adquirir el bloqueo para reemplazar conectores: ${LastException.Message}"$).Append(" " & CRLF) - reloadSuccessful = False - End Try - - If lock2Acquired Then - Main.MainConnectorsLock.RunMethod("unlock", Null) - End If - - If reloadSuccessful Then ' Si el swap fue exitoso - - ' <<< PASO CLAVE 3: APLICAR EL NUEVO ESTADO GLOBAL GRANULAR Y REINICIAR TIMER >>> - - ' 3a. Reemplazar el mapa de estados de logging granular - Main.SQLiteLoggingStatusByDB.Clear ' Limpiamos el mapa global - - Dim isAnyEnabled As Boolean = False - For Each dbKey As String In Main.listaDeCP - ' Recuperamos el estado logueado temporalmente. - Dim isEnabled As Boolean = newConnectors.Get(dbKey & "_LOG_STATE").As(Boolean) - Main.SQLiteLoggingStatusByDB.Put(dbKey, isEnabled) ' Aplicamos el estado al mapa global - - If isEnabled Then isAnyEnabled = True ' Calculamos el flag general - Next - - ' 3b. Controlar el Timer y el flag global - Main.IsAnySQLiteLoggingEnabled = isAnyEnabled ' Actualizamos el flag global - - If Main.IsAnySQLiteLoggingEnabled Then - Main.timerLogs.Enabled = True - sb.Append($" -> Logs de SQLite HABILITADOS (Granular). Timer de limpieza ACTIVADO."$).Append(" " & CRLF) - Else - Main.timerLogs.Enabled = False - sb.Append($" -> Logs de SQLite DESHABILITADOS (Total). Timer de limpieza PERMANECERÁ DETENIDO."$).Append(" " & CRLF) - End If - ' <<< FIN PASO CLAVE 3 >>> - - sb.Append($"¡Recarga de configuración completada con éxito (Hot-Swap)!"$).Append(" " & CRLF) - - ' ... (Resto del código: Mostrar estado de pools y Cierre explícito de oldConnectors) ... - - Else - sb.Append($"¡ERROR: La recarga de configuración falló en la fase de reemplazo de conectores! Los conectores antiguos siguen activos."$).Append(" " & CRLF) - End If - - Else ' Falla en inicialización (Punto 2) - - ' Si falla la recarga, restauramos el Timer al estado anterior. - If oldTimerState Then - Main.timerLogs.Enabled = True - sb.Append(" -> Restaurando Timer de limpieza de logs (SQLite) al estado ACTIVO debido a fallo en recarga.").Append(" " & CRLF) - End If - - sb.Append($"¡ERROR: La recarga de configuración falló durante la inicialización de nuevos conectores! Los conectores antiguos siguen activos."$).Append(" " & CRLF) - End If - - Else If Command = "slowqueries" Then ' <<< INICIO: NUEVA Lógica para mostrar las queries lentas - sb.Append("

Consultas Lentas Recientes

") - sb.Append("(Este registro depende de que los logs estén habilitados con del parámetro ""enableSQLiteLogs=1"" en config properties)

") - Try - ' 1. Calcular el límite de tiempo: el tiempo actual (en milisegundos) menos 1 hora (3,600,000 ms). - Dim oneHourAgoMs As Long = DateTime.Now - 3600000 - - ' Ajusta la consulta SQL para obtener las 20 queries más lentas. - ' Utilizamos datetime con 'unixepoch' y 'localtime' para una visualización legible del timestamp. - 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"$) - - sb.Append("") - sb.Append("") - sb.Append("") - - Do While rs.NextRow - sb.Append("") - sb.Append($""$) - sb.Append($""$) - sb.Append($""$) - sb.Append($""$) - sb.Append($""$) - sb.Append($""$) - sb.Append($""$) - sb.Append("") - Loop - sb.Append("") - sb.Append("
QueryDuración (ms)Fecha/Hora LocalDB KeyCliente IPConex. OcupadasPeticiones Activas
${rs.GetString("query_name")}${rs.GetLong("duration_ms")}${rs.GetString("timestamp_local")}${rs.GetString("db_key")}${rs.GetString("client_ip")}${rs.GetInt("busy_connections")}${rs.GetInt("handler_active_requests")}
") - rs.Close - Catch - Log("Error al obtener queries lentas en Manager: " & LastException.Message) - sb.Append($"

Error al cargar queries lentas: ${LastException.Message}

"$) - End Try - Else If Command = "test" Then - Try - Dim con As SQL = Main.Connectors.Get("DB1").As(RDCConnector).GetConnection("") - sb.Append("Connection successful.

") - Private estaDB As String = "" - Log(Main.listaDeCP) - For i = 0 To Main.listaDeCP.Size - 1 - If Main.listaDeCP.get(i) <> "" Then estaDB = "." & Main.listaDeCP.get(i) - sb.Append($"Using config${estaDB}.properties
"$) - Next - con.Close - Catch - resp.Write("Error fetching connection.") - End Try - Else If Command = "stop" Then - ' Public shl As Shell... - Else If Command = "rsx" Then - Log($"Ejecutamos ${File.DirApp}\start.bat"$) - sb.Append($"Ejecutamos ${File.DirApp}\start.bat"$) - Public shl As Shell - shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\start.bat " & Main.srvr.Port)) - shl.WorkingDirectory = File.DirApp - shl.Run(-1) - Else If Command = "rpm2" Then - Log($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$) - sb.Append($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$) - Public shl As Shell - shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\reiniciaProcesoPM2.bat " & Main.srvr.Port)) - shl.WorkingDirectory = File.DirApp - shl.Run(-1) - Else If Command = "reviveBow" Then - Log($"Ejecutamos ${File.DirApp}\reiniciaProcesoBow.bat"$) - sb.Append($"Ejecutamos ${File.DirApp}\reiniciaProcesoBow.bat

"$) - sb.Append($"!!!BOW REINICIANDO!!!"$) - Public shl As Shell - shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\reiniciaProcesoBow.bat " & Main.srvr.Port)) - shl.WorkingDirectory = File.DirApp - shl.Run(-1) - Else If Command = "paused" Then - GlobalParameters.IsPaused = 1 - sb.Append("Servidor pausado.") - Else If Command = "continue" Then - GlobalParameters.IsPaused = 0 - sb.Append("Servidor reanudado.") - Else If Command = "logs" Then - If GlobalParameters.mpLogs.IsInitialized Then - j.Initialize(GlobalParameters.mpLogs) - sb.Append(j.ToString) - End If - Else If Command = "block" Then - Dim BlockedConIP As String = req.GetParameter("IP") - If GlobalParameters.mpBlockConnection.IsInitialized Then - GlobalParameters.mpBlockConnection.Put(BlockedConIP, BlockedConIP) - sb.Append("IP bloqueada: " & BlockedConIP) - End If - Else If Command = "unblock" Then - Dim UnBlockedConIP As String = req.GetParameter("IP") - If GlobalParameters.mpBlockConnection.IsInitialized Then - GlobalParameters.mpBlockConnection.Remove(UnBlockedConIP) - sb.Append("IP desbloqueada: " & UnBlockedConIP) - End If - Else If Command = "restartserver" Then - Log($"Ejecutamos ${File.DirApp}/restarServer.bat"$) - sb.Append("Reiniciando servidor...") - Else If Command = "runatstartup" Then - File.Copy("C:\jrdcinterface", "startup.bat", "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\StartUp", "startup.bat") - sb.Append("Script de inicio añadido.") - Else If Command = "stoprunatstartup" Then - File.Delete("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\StartUp", "startup.bat") - sb.Append("Script de inicio eliminado.") - Else If Command = "totalrequests" Then - If GlobalParameters.mpTotalRequests.IsInitialized Then - j.Initialize(GlobalParameters.mpTotalRequests) - sb.Append(j.ToString) - End If - Else If Command = "totalblocked" Then - If GlobalParameters.mpBlockConnection.IsInitialized Then -' j.Initialize(Global.mpBlockConnection) - sb.Append(j.ToString) - End If - Else If Command = "ping" Then - sb.Append($"Pong ($DateTime{DateTime.Now})"$) - Else If Command = "totalcon" Then ' <<< Modificado: Ahora usa GetPoolStats para cada pool - ' Verificamos que el mapa global de conexiones esté inicializado. - ' Aunque no lo poblamos directamente, es un buen chequeo de estado. - If GlobalParameters.mpTotalConnections.IsInitialized Then - sb.Append("

Estadísticas del Pool de Conexiones por DB:

") - - ' Creamos un mapa LOCAL para almacenar las estadísticas de TODOS los pools de conexiones. + ' --- Comandos que devuelven JSON --- + Case "getstats" + resp.ContentType = "application/json; charset=utf-8" Dim allPoolStats As Map allPoolStats.Initialize - - ' Iteramos sobre cada clave de base de datos que tenemos configurada (DB1, DB2, etc.). - For Each dbKey As String In Main.listaDeCP - ' Obtenemos el conector RDC para la base de datos actual. - Dim connector As RDCConnector = Main.Connectors.Get(dbKey).As(RDCConnector) - - ' Si el conector no está inicializado (lo cual no debería ocurrir si Main.AppStart funcionó), - ' registramos un error y pasamos al siguiente. - If connector.IsInitialized = False Then - Log($"Manager: ADVERTENCIA: El conector para ${dbKey} no está inicializado."$) - Dim errorMap As Map = CreateMap("Error": "Conector no inicializado o no cargado correctamente") - allPoolStats.Put(dbKey, errorMap) - Continue ' Salta a la siguiente iteración del bucle. - End If - - ' Llamamos al método GetPoolStats del conector para obtener las métricas de su pool. - Dim poolStats As Map = connector.GetPoolStats - - ' Añadimos las estadísticas de este pool (poolStats) al mapa general (allPoolStats), - ' usando la clave de la base de datos (dbKey) como su identificador. - allPoolStats.Put(dbKey, poolStats) - Next - - ' Inicializamos el generador JSON con el mapa 'allPoolStats' (que ahora sí debería contener datos). - ' (La variable 'j' ya está declarada en Class_Globals de Manager.bas, no la declares de nuevo aquí). - j.Initialize(allPoolStats) - - ' Añadimos la representación JSON de las estadísticas al StringBuilder para la respuesta HTML. - sb.Append(j.ToString) - Else - sb.Append("El mapa de conexiones GlobalParameters.mpTotalConnections no está inicializado.") - End If - End If - ' ========================================================================= - ' ### FIN DE TU LÓGICA DE COMANDOS ### - ' ========================================================================= - - ' --- Cerramos la página y la enviamos --- - sb.Append("

Cerrar Sesión | Cambiar Contraseña

") - resp.Write(sb.ToString) - If GlobalParameters.mpLogs.IsInitialized Then GlobalParameters.mpLogs.Put(Command, "Manager : " & Command & " - Time : " & DateTime.Time(DateTime.Now)) -End Sub + For Each dbKey As String In Main.listaDeCP + Dim connector As RDCConnector = Main.Connectors.Get(dbKey) + If connector.IsInitialized Then + allPoolStats.Put(dbKey, connector.GetPoolStats) + Else + allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado")) + End If + Next + + j.Initialize(allPoolStats) + resp.Write(j.ToString) + Return + + Case "slowqueries" + resp.ContentType = "application/json; charset=utf-8" + Dim results As List + results.Initialize + Try + ' Verificamos si la tabla de logs existe antes de consultarla + Dim tableExists As Boolean = Main.SQL1.ExecQuerySingleResult($"SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs';"$) <> Null + If tableExists = False Then + ' Si la tabla no existe, devolvemos un JSON con un mensaje claro y terminamos. + j.Initialize(CreateMap("message": "La tabla de logs ('query_logs') no existe. Habilita 'enableSQLiteLogs=1' en la configuración.")) + resp.Write(j.ToString) + Return + End If + + ' La tabla existe, procedemos con la consulta original + Dim oneHourAgoMs As Long = DateTime.Now - 3600000 + Dim rs As ResultSet = Main.SQL1.ExecQuery($"SELECT query_name, duration_ms, datetime(timestamp / 1000, 'unixepoch', 'localtime') as timestamp_local, db_key, client_ip, busy_connections, handler_active_requests FROM query_logs WHERE timestamp >= ${oneHourAgoMs} ORDER BY duration_ms DESC LIMIT 20"$) + + Do While rs.NextRow + Dim row As Map + row.Initialize + row.Put("Query", rs.GetString("query_name")) + row.Put("Duracion_ms", rs.GetLong("duration_ms")) + row.Put("Fecha_Hora", rs.GetString("timestamp_local")) + row.Put("DB_Key", rs.GetString("db_key")) + row.Put("Cliente_IP", rs.GetString("client_ip")) + row.Put("Conexiones_Ocupadas", rs.GetInt("busy_connections")) + row.Put("Peticiones_Activas", rs.GetInt("handler_active_requests")) + results.Add(row) + Loop + rs.Close + + ' 1. Creamos un mapa "raíz" para contener nuestra lista. + Dim root As Map + root.Initialize + root.Put("data", results) ' La llave puede ser lo que quieras, "data" es común. + + ' 2. Ahora sí, inicializamos el generador con el mapa raíz. + j.Initialize(root) + resp.Write(j.ToString) + + Catch + Log("Error CRÍTICO al obtener queries lentas en Manager API: " & LastException.Message) + + ' <<< CORRECCIÓN AQUÍ >>> + ' Se utiliza la propiedad .Status para asignar el código de error + resp.Status = 500 ' Internal Server Error + + ' 1. Creamos un mapa "raíz" para contener nuestra lista. + Dim root As Map + root.Initialize + root.Put("data", results) ' La llave puede ser lo que quieras, "data" es común. + + ' 2. Ahora sí, inicializamos el generador con el mapa raíz. + j.Initialize(root) + resp.Write(j.ToString) + End Try + Return + + Case "logs", "totalrequests", "totalblocked" + resp.ContentType = "application/json; charset=utf-8" + Dim mp As Map + If Command = "logs" And GlobalParameters.mpLogs.IsInitialized Then mp = GlobalParameters.mpLogs + If Command = "totalrequests" And GlobalParameters.mpTotalRequests.IsInitialized Then mp = GlobalParameters.mpTotalRequests + If Command = "totalblocked" And GlobalParameters.mpBlockConnection.IsInitialized Then mp = GlobalParameters.mpBlockConnection + + If mp.IsInitialized Then + j.Initialize(mp) + resp.Write(j.ToString) + Else + resp.Write("{}") + End If + Return + + ' --- Comandos que devuelven TEXTO PLANO --- + Case "ping" + resp.ContentType = "text/plain" + resp.Write($"Pong ($DateTime{DateTime.Now})"$) + Return + + Case "reload" + resp.ContentType = "text/plain; charset=utf-8" + Dim sbTemp As StringBuilder + sbTemp.Initialize + + ' <<< LÓGICA ORIGINAL: Se mantiene intacta toda la lógica de recarga >>> + ' (Copiada y pegada directamente de tu código anterior) + sbTemp.Append($"Iniciando recarga de configuración (Hot-Swap) ($DateTime{DateTime.Now})"$).Append(" " & CRLF) + Dim oldTimerState As Boolean = Main.timerLogs.Enabled + If oldTimerState Then + Main.timerLogs.Enabled = False + sbTemp.Append(" -> Timer de limpieza de logs (SQLite) detenido temporalmente.").Append(" " & CRLF) + End If + Dim newConnectors As Map + newConnectors.Initialize + Dim oldConnectors As Map + Dim reloadSuccessful As Boolean = True + Main.MainConnectorsLock.RunMethod("lock", Null) + oldConnectors = Main.Connectors + Main.MainConnectorsLock.RunMethod("unlock", Null) + + For Each dbKey As String In Main.listaDeCP + Try + Dim newRDC As RDCConnector + newRDC.Initialize(dbKey) + Dim enableLogsSetting As Int = newRDC.config.GetDefault("enableSQLiteLogs", 0) + Dim isEnabled As Boolean = (enableLogsSetting = 1) + newConnectors.Put(dbKey & "_LOG_STATE", isEnabled) + sbTemp.Append($" -> Logs de ${dbKey} activados: ${isEnabled}"$).Append(" " & CRLF) + newConnectors.Put(dbKey, newRDC) + Dim newPoolStats As Map = newRDC.GetPoolStats + sbTemp.Append($" -> ${dbKey}: Nuevo conector inicializado. Conexiones: ${newPoolStats.Get("TotalConnections")}"$).Append(" " & CRLF) + Catch + sbTemp.Append($" -> ERROR CRÍTICO al inicializar nuevo conector para ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF) + reloadSuccessful = False + Exit + End Try + Next + + If reloadSuccessful Then + Main.MainConnectorsLock.RunMethod("lock", Null) + Main.Connectors = newConnectors + Main.MainConnectorsLock.RunMethod("unlock", Null) + Main.SQLiteLoggingStatusByDB.Clear + Dim isAnyEnabled As Boolean = False + For Each dbKey As String In Main.listaDeCP + Dim isEnabled As Boolean = newConnectors.Get(dbKey & "_LOG_STATE") + Main.SQLiteLoggingStatusByDB.Put(dbKey, isEnabled) + If isEnabled Then isAnyEnabled = True + Next + Main.IsAnySQLiteLoggingEnabled = isAnyEnabled + If Main.IsAnySQLiteLoggingEnabled Then + Main.timerLogs.Enabled = True + sbTemp.Append($" -> Logs de SQLite HABILITADOS (Granular). Timer de limpieza ACTIVADO."$).Append(" " & CRLF) + Else + Main.timerLogs.Enabled = False + sbTemp.Append($" -> Logs de SQLite DESHABILITADOS (Total). Timer de limpieza PERMANECERÁ DETENIDO."$).Append(" " & CRLF) + End If + sbTemp.Append($"¡Recarga de configuración completada con éxito (Hot-Swap)!"$).Append(" " & CRLF) + Else + If oldTimerState Then + Main.timerLogs.Enabled = True + sbTemp.Append(" -> Restaurando Timer de limpieza de logs (SQLite) al estado ACTIVO debido a fallo en recarga.").Append(" " & CRLF) + End If + sbTemp.Append($"¡ERROR: La recarga de configuración falló! Los conectores antiguos siguen activos."$).Append(" " & CRLF) + End If + + ' <<< CAMBIO: Se devuelve el contenido del StringBuilder como texto plano >>> + resp.Write(sbTemp.ToString) + Return + + Case "test" + resp.ContentType = "text/plain; charset=utf-8" + Dim sb As StringBuilder + sb.Initialize + Try + Dim con As SQL = Main.Connectors.Get("DB1").As(RDCConnector).GetConnection("") + sb.Append("Connection successful." & CRLF & CRLF) + Dim estaDB As String = "" + Log(Main.listaDeCP) + For i = 0 To Main.listaDeCP.Size - 1 + If Main.listaDeCP.get(i) <> "" Then estaDB = "." & Main.listaDeCP.get(i) + sb.Append($"Using config${estaDB}.properties"$ & CRLF) + Next + con.Close + resp.Write(sb.ToString) + Catch + resp.Write("Error fetching connection: " & LastException.Message) + End Try + Return + + Case "rsx", "rpm2", "revivebow", "restartserver" + resp.ContentType = "text/plain; charset=utf-8" + Dim batFile As String + Select Command + Case "rsx": batFile = "start.bat" + Case "rpm2": batFile = "reiniciaProcesoPM2.bat" + Case "reviveBow": batFile = "reiniciaProcesoBow.bat" + Case "restartserver": batFile = "restarServer.bat" + End Select + Log($"Ejecutando ${File.DirApp}\${batFile}"$) + Try + Dim shl As Shell + shl.Initialize("shl","cmd", Array("/c", File.DirApp & "\" & batFile & " " & Main.srvr.Port)) + shl.WorkingDirectory = File.DirApp + shl.Run(-1) + resp.Write($"Comando '${Command}' ejecutado. Script invocado: ${batFile}"$) + Catch + resp.Write($"Error al ejecutar el script para '${Command}': ${LastException.Message}"$) + End Try + Return + + + Log($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$) + sb.Append($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$) + Public shl As Shell + shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\reiniciaProcesoPM2.bat " & Main.srvr.Port)) + shl.WorkingDirectory = File.DirApp + shl.Run(-1) + + Case "paused", "continue" + resp.ContentType = "text/plain; charset=utf-8" + If Command = "paused" Then + GlobalParameters.IsPaused = 1 + resp.Write("Servidor pausado.") + Else + GlobalParameters.IsPaused = 0 + resp.Write("Servidor reanudado.") + End If + Return + + Case "block", "unblock" + resp.ContentType = "text/plain; charset=utf-8" + Dim ip As String = req.GetParameter("IP") + If ip = "" Then + resp.Write("Error: El parámetro IP es requerido.") + Return + End If + If GlobalParameters.mpBlockConnection.IsInitialized Then + If Command = "block" Then + GlobalParameters.mpBlockConnection.Put(ip, ip) + resp.Write($"IP bloqueada: ${ip}"$) + Else + GlobalParameters.mpBlockConnection.Remove(ip) + resp.Write($"IP desbloqueada: ${ip}"$) + End If + Else + resp.Write("Error: El mapa de bloqueo no está inicializado.") + End If + Return + + Case Else + resp.ContentType = "text/plain; charset=utf-8" + resp.SendError(404, $"Comando desconocido: '{Command}'"$) + Return + + End Select +End Sub \ No newline at end of file diff --git a/ParameterValidationUtils.bas b/ParameterValidationUtils.bas index fea065d..e5b5eff 100644 --- a/ParameterValidationUtils.bas +++ b/ParameterValidationUtils.bas @@ -50,6 +50,7 @@ Public Sub ValidateAndAdjustParameters (CommandName As String, DBKey As String, 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."$ Log(WarningMsg) + Log("Cache: " & Main.LOG_CACHE_THRESHOLD & "|" & Main.ErrorLogCache.Size) Main.LogServerError("ADVERTENCIA", "ParameterValidationUtils.ValidateAndAdjustParameters", WarningMsg, DBKey, CommandName, Null) ' <-- Nuevo Log [6] Else ' Si la tolerancia NO está habilitada, esto es un error crítico. diff --git a/jRDC_Multi.b4j b/jRDC_Multi.b4j index 353ea03..e7c92e2 100644 --- a/jRDC_Multi.b4j +++ b/jRDC_Multi.b4j @@ -32,10 +32,11 @@ Library8=jsql Library9=bcrypt Module1=Cambios Module10=Manager -Module11=ParameterValidationUtils -Module12=ping -Module13=RDCConnector -Module14=TestHandler +Module11=Manager0 +Module12=ParameterValidationUtils +Module13=ping +Module14=RDCConnector +Module15=TestHandler Module2=ChangePassHandler Module3=DBHandlerB4X Module4=DBHandlerJSON @@ -46,7 +47,7 @@ Module8=LoginHandler Module9=LogoutHandler NumberOfFiles=10 NumberOfLibraries=9 -NumberOfModules=14 +NumberOfModules=15 Version=10.3 @EndOfDesignText@ 'Non-UI application (console / server application) @@ -55,7 +56,7 @@ Version=10.3 #CommandLineArgs: #MergeLibraries: True -' VERSION 5.09.16.2 +' VERSION 5.09.17 '########################################################################################################### '###################### PULL ############################################################# 'Ctrl + click ide://run?file=%WINDIR%\System32\cmd.exe&Args=/c&Args=git&Args=pull @@ -125,7 +126,7 @@ Sub Process_Globals Public QueryLogCache As List ' Cache para los logs de rendimiento (query_logs) Public ErrorLogCache As List ' Cache para los logs de errores y advertencias - Public Const LOG_CACHE_THRESHOLD As Int = 10 ' Umbral de registros para forzar la escritura + Public LOG_CACHE_THRESHOLD As Int = 350 ' Umbral de registros para forzar la escritura Dim logger As Boolean End Sub @@ -133,6 +134,7 @@ End Sub Sub AppStart (Args() As String) #if DEBUG logger = True + LOG_CACHE_THRESHOLD = 10 #else logger = False #End If @@ -178,7 +180,7 @@ Sub AppStart (Args() As String) Log($"Main.AppStart: Conector 'DB1' inicializado exitosamente en puerto: ${srvr.Port}"$) ' Lógica de Logs para DB1 (Fuente principal de configuración) - Dim enableLogsSetting As Int = con1.config.GetDefault("enableSQLiteLogs", 1).As(Int) + Dim enableLogsSetting As Int = con1.config.GetDefault("enableSQLiteLogs", 0).As(Int) Dim isEnabled As Boolean = (enableLogsSetting = 1) SQLiteLoggingStatusByDB.Put("DB1", isEnabled) ' Guardar el estado @@ -661,8 +663,16 @@ End Sub Sub borraArribaDe15000Logs 'ignore If IsAnySQLiteLoggingEnabled Then ' Solo ejecutar si al menos una DB requiere logs. + If logger Then Log("Recortando la tabla de 'query_logs', límite de 15,000 registros.") + ' 1. Limpieza de Logs de Rendimiento (query_logs) If logger Then Log("Recortando la tabla de 'query_logs', límite de 15,000 registros.") SQL1.ExecNonQuery("DELETE FROM query_logs WHERE timestamp NOT in (SELECT timestamp FROM query_logs ORDER BY timestamp desc LIMIT 15000 )") + + ' 2. Limpieza de Logs de Errores (errores) + If logger Then Log("Recortando la tabla de 'errores', límite de 15,000 registros.") + SQL1.ExecNonQuery("DELETE FROM errores WHERE timestamp NOT in (SELECT timestamp FROM errores ORDER BY timestamp desc LIMIT 15000 )") + + ' 3. Optimización de disco SQL1.ExecNonQuery("vacuum;") Else ' Si IsAnySQLiteLoggingEnabled es False, el Timer no debería estar activo. diff --git a/jRDC_Multi.b4j.meta b/jRDC_Multi.b4j.meta index 67c3490..c267407 100644 --- a/jRDC_Multi.b4j.meta +++ b/jRDC_Multi.b4j.meta @@ -5,6 +5,7 @@ ModuleBookmarks11= ModuleBookmarks12= ModuleBookmarks13= ModuleBookmarks14= +ModuleBookmarks15= ModuleBookmarks2= ModuleBookmarks3= ModuleBookmarks4= @@ -20,6 +21,7 @@ ModuleBreakpoints11= ModuleBreakpoints12= ModuleBreakpoints13= ModuleBreakpoints14= +ModuleBreakpoints15= ModuleBreakpoints2= ModuleBreakpoints3= ModuleBreakpoints4= @@ -35,14 +37,15 @@ ModuleClosedNodes11= ModuleClosedNodes12= ModuleClosedNodes13= ModuleClosedNodes14= +ModuleClosedNodes15= ModuleClosedNodes2= -ModuleClosedNodes3=9,10,11,12,13,14,15,16 +ModuleClosedNodes3= ModuleClosedNodes4= ModuleClosedNodes5= ModuleClosedNodes6= ModuleClosedNodes7= ModuleClosedNodes8= ModuleClosedNodes9= -NavigationStack=Main,TimerLogs_Tick,533,0,Main,LogQueryPerformance,414,5,Main,LogServerError,459,0,Main,AppStart,244,0,Main,WriteQueryLogsBatch,512,1,Main,borraArribaDe15000Logs,617,0,Main,WriteErrorLogsBatch,602,1,Main,InitializeSQLiteDatabase,365,0,Main,Process_Globals,76,4,Cambios,Process_Globals,22,6 +NavigationStack=DBHandlerJSON,SendSuccessResponse,253,0,DBHandlerJSON,CleanupAndLog,248,0,RDCConnector,Class_Globals,21,0,RDCConnector,Initialize,35,0,Main,LogServerError,453,0,DBHandlerB4X,ExecuteBatch2,342,0,DBHandlerJSON,Class_Globals,7,0,DBHandlerB4X,ExecuteBatch,445,6,DBHandlerJSON,Handle,201,6,Main,borraArribaDe15000Logs,623,0,Cambios,Process_Globals,22,0 SelectedBuild=0 -VisibleModules=3,4,13,1,10,11,14,2 +VisibleModules=3,4,14,1,10,12