- 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`.
This commit is contained in:
2025-09-23 00:15:47 -06:00
parent 884cb96f9d
commit 820fe9fc2b
7 changed files with 538 additions and 605 deletions

View File

@@ -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
'

View File

@@ -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

View File

@@ -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 ---

View File

@@ -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("<html><head><style>")
sb.Append("body {font-family: sans-serif; margin: 2em; background-color: #f9f9f9;} ")
sb.Append("h1, h2 {color: #333;} hr {margin: 2em 0; border: 0; border-top: 1px solid #ddd;} ")
sb.Append("input {display: block; width: 95%; padding: 8px; margin-bottom: 10px; border: 1px solid #ccc; border-radius: 4px;} ")
sb.Append("button {padding: 10px 15px; border: none; background-color: #007bff; color: white; cursor: pointer; border-radius: 4px; margin-right: 1em;} ")
sb.Append(".nav a, .logout a {text-decoration: none; margin-right: 10px; color: #007bff;} ")
sb.Append(".output {background: #fff; padding: 1em; border: 1px solid #eee; border-radius: 8px; font-family: monospace; white-space: pre-wrap; word-wrap: break-word;} ")
sb.Append("#changePassForm {background: #f0f0f0; padding: 1.5em; border-radius: 8px; max-width: 400px; margin-top: 1em;} ")
sb.Append("</style>")
sb.Append("<script>function toggleForm() {var form = document.getElementById('changePassForm'); if (form.style.display === 'none') {form.style.display = 'block';} else {form.style.display = 'none';}}</script>")
sb.Append("</head><body>")
' --- Cabecera de la Página y Mensaje de Bienvenida ---
sb.Append("<h1>Panel de Administración jRDC</h1>")
sb.Append($"<p>Bienvenido, <strong>${req.GetSession.GetAttribute("username")}</strong></p>"$)
' --- Menú de Navegación del Manager ---
' Este menú incluye las opciones para interactuar con el servidor.
sb.Append("<div class='menu'>")
sb.Append("<a href='/manager?command=test'>Test</a> | ")
sb.Append("<a href='/manager?command=ping'>Ping</a> | ")
sb.Append("<a href='/manager?command=reload'>Reload</a> | ")
sb.Append("<a href='/manager?command=slowqueries'>Queries Lentas</a> | ") ' Nuevo enlace para queries lentas.
sb.Append("<a href='/manager?command=totalcon'>Estadísticas Pool</a> | ") ' Nuevo enlace para estadísticas del pool.
sb.Append("<a href='/manager?command=rpm2'>Reiniciar (pm2)</a> | ")
sb.Append("<a href='/manager?command=reviveBow'>Revive Bow</a>")
sb.Append("</div>")
sb.Append("<hr>")
sb.Append("<div id='changePassForm' style='display:none;'>")
sb.Append("<h2>Cambiar Contraseña</h2><form action='/changepass' method='post'>")
sb.Append("Contraseña Actual: <input type='password' name='current_password' required><br>")
sb.Append("Nueva Contraseña: <input type='password' name='new_password' required><br>")
sb.Append("Confirmar Nueva Contraseña: <input type='password' name='confirm_password' required><br>")
sb.Append("<button type='submit'>Actualizar Contraseña</button> <button onclick='toggleForm()'>Cancelar</button></form></div>")
' --- Resultado del Comando ---
sb.Append("<h2>Resultado del Comando: '" & Command & "'</h2>")
sb.Append("<div class='output'>")
' =========================================================================
' ### 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("<h2 style=""margin-top:0px;margin-bottom:0px;"">Consultas Lentas Recientes</h2>")
sb.Append("(Este registro depende de que los logs estén habilitados con del parámetro ""enableSQLiteLogs=1"" en config properties)<br><br>")
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("<table border='1' style='width:100%; text-align:left; border-collapse: collapse;'>")
sb.Append("<thead><tr><th>Query</th><th>Duración (ms)</th><th>Fecha/Hora Local</th><th>DB Key</th><th>Cliente IP</th><th>Conex. Ocupadas</th><th>Peticiones Activas</th></tr></thead>")
sb.Append("<tbody>")
Do While rs.NextRow
sb.Append("<tr>")
sb.Append($"<td>${rs.GetString("query_name")}</td>"$)
sb.Append($"<td>${rs.GetLong("duration_ms")}</td>"$)
sb.Append($"<td>${rs.GetString("timestamp_local")}</td>"$)
sb.Append($"<td>${rs.GetString("db_key")}</td>"$)
sb.Append($"<td>${rs.GetString("client_ip")}</td>"$)
sb.Append($"<td>${rs.GetInt("busy_connections")}</td>"$)
sb.Append($"<td>${rs.GetInt("handler_active_requests")}</td>"$)
sb.Append("</tr>")
Loop
sb.Append("</tbody>")
sb.Append("</table>")
rs.Close
Catch
Log("Error al obtener queries lentas en Manager: " & LastException.Message)
sb.Append($"<p style='color:red;'>Error al cargar queries lentas: ${LastException.Message}</p>"$)
End Try
Else If Command = "test" Then
Try
Dim con As SQL = Main.Connectors.Get("DB1").As(RDCConnector).GetConnection("")
sb.Append("Connection successful.</br></br>")
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<br/>"$)
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<br><br>"$)
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("<h2>Estadísticas del Pool de Conexiones por DB:</h2>")
' 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("</div><p class='logout'><a href='/logout'>Cerrar Sesión</a> | <a href=# onclick='toggleForm()'>Cambiar Contraseña</a></p></body></html>")
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

View File

@@ -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.

View File

@@ -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.

View File

@@ -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