cheveguerra/jRDC-Multi
1
0
Fork 0
mirror of https://github.com/KeymonSoft/jRDC-Multi.git synced 2026-04-17 21:06:24 +00:00
Code Issues Packages Projects Releases Wiki Activity

- VERSION 5.09.17

Browse Source 
- 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:
Jose Alberto Guerra Ugalde
2025-09-23 00:15:47 -06:00
parent 884cb96f9d
commit 820fe9fc2b
7 changed files with 538 additions and 605 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
Cambios.bas
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 ' - 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. ' 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 ' - VERSION 5.09.16.2
' - feat(logs): Implementación de Cacheo y Escritura Transaccional en Lotes ' - feat(logs): Implementación de Cacheo y Escritura Transaccional en Lotes
' '

433
DBHandlerB4X.bas
View File

@@ -17,15 +17,15 @@ Sub Class_Globals
' La siguiente sección de constantes y utilidades se compila condicionalmente ' La siguiente sección de constantes y utilidades se compila condicionalmente
' solo si la directiva #if VERSION1 está activa. Esto es para dar soporte ' 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. ' 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). ' 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 ,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
' Utilidades para convertir entre tipos de datos y arrays de bytes. ' 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). ' Utilidad para comprimir/descomprimir streams de datos (usado en V1).
Private cs As CompressedStreams Private cs As CompressedStreams
' #end if ' #end if
' Mapa para convertir tipos de columna JDBC de fecha/hora a los nombres de métodos de Java ' 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. ' 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) CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return ' Salida temprana si hay un error. Return ' Salida temprana si hay un error.
End If End If
' #if VERSION1 ' #if VERSION1
' Estas ramas se compilan solo si #if VERSION1 está activo (para protocolo antiguo). ' Estas ramas se compilan solo si #if VERSION1 está activo (para protocolo antiguo).
Else if method = "query" Then Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1. in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1.
q = ExecuteQuery(dbKey, con, in, resp) q = ExecuteQuery(dbKey, con, in, resp)
If q = "error" Then If q = "error" Then
duration = DateTime.Now - start duration = DateTime.Now - start
CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return Return
End If End If
Else if method = "batch" Then Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1. in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1.
q = ExecuteBatch(dbKey, con, in, resp) q = ExecuteBatch(dbKey, con, in, resp)
If q = "error" Then If q = "error" Then
duration = DateTime.Now - start duration = DateTime.Now - start
CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return Return
End If End If
' #end if ' #end if
Else if method = "batch2" Then Else if method = "batch2" Then
' Ejecuta un lote de comandos (INSERT, UPDATE, DELETE) utilizando el protocolo V2. ' Ejecuta un lote de comandos (INSERT, UPDATE, DELETE) utilizando el protocolo V2.
q = ExecuteBatch2(dbKey, con, in, resp) q = ExecuteBatch2(dbKey, con, in, resp)
@@ -427,34 +427,41 @@ End Sub
' Ejecuta un lote de comandos usando el protocolo V1. ' 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 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. Log($"ExecuteBatch ${DB}"$)
Dim clientVersion As Float = ReadObject(in) 'ignore ' Lee y descarta la versión del cliente.
' Lee cuántos comandos vienen en el lote. Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in) ' Lee cuántos comandos vienen en el lote.
Dim res(numberOfStatements) As Int ' Array para resultados (aunque no se usa). Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int ' Array para resultados (aunque no se usa).
Dim singleQueryName As String = "" Dim singleQueryName As String = ""
Dim affectedCounts As List
Dim totalAffectedRows As Int
affectedCounts.Initialize
Try Try
con.BeginTransaction con.BeginTransaction
' Itera para procesar cada comando del lote. ' Itera para procesar cada comando del lote.
For i = 0 To numberOfStatements - 1 Log(numberOfStatements)
' Lee el nombre del comando y la lista de parámetros usando el deserializador V1. For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in) Log($"i: ${i}"$)
Dim params As List = ReadList(in) ' 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 If numberOfStatements = 1 Then
singleQueryName = queryName 'Capturamos el nombre del query. singleQueryName = queryName 'Capturamos el nombre del query.
End If End If
Dim sqlCommand As String = Connector.GetCommand(DB, queryName) Dim sqlCommand As String = Connector.GetCommand(DB, queryName)
Log(sqlCommand)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>> ' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
con.Rollback ' Deshace la transacción si un comando es inválido. 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}'."$ Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage) Log(errorMessage)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", errorMessage, DB, queryName, Null) Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", errorMessage, DB, queryName, Null)
SendPlainTextError(resp, 400, errorMessage) SendPlainTextError(resp, 400, errorMessage)
Return "error" Return "error"
End If End If
' <<< FIN NUEVA VALIDACIÓN >>> ' <<< FIN NUEVA VALIDACIÓN >>>
' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH (V1) >>> ' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH (V1) >>>
@@ -466,28 +473,38 @@ Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As Se
Return "error" ' Salida temprana si la validación falla. Return "error" ' Salida temprana si la validación falla.
End If 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. 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) >>> ' <<< 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)
con.TransactionSuccessful ' Confirma la transacción. Next
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip") ' Comprime la salida antes de enviarla. con.TransactionSuccessful ' Confirma la transacción.
' 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
Catch Log("Transaction succesfull")
con.Rollback
Log(LastException) 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)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", LastException.Message, DB, "batch_execution_error_v1", Null) Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", LastException.Message, DB, "batch_execution_error_v1", Null)
SendPlainTextError(resp, 500, LastException.Message) SendPlainTextError(resp, 500, LastException.Message)
End Try End Try
' Return $"batch (size=${numberOfStatements})"$ ' Return $"batch (size=${numberOfStatements})"$
If numberOfStatements = 1 And singleQueryName <> "" Then If numberOfStatements = 1 And singleQueryName <> "" Then
@@ -499,24 +516,24 @@ End Sub
' Ejecuta una consulta única usando el protocolo V1. ' 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 Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("====================== ExecuteQuery =====================") ' Log("====================== ExecuteQuery =====================")
' Deserializa los datos de la petición usando el protocolo V1. ' Deserializa los datos de la petición usando el protocolo V1.
Dim clientVersion As Float = ReadObject(in) 'ignore Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in) Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in) Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in) Dim params As List = ReadList(in)
' Obtiene la sentencia SQL. ' Obtiene la sentencia SQL.
Dim theSql As String = Connector.GetCommand(DB, queryName) Dim theSql As String = Connector.GetCommand(DB, queryName)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>> ' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If theSql = Null Or theSql ="null" Or theSql.Trim = "" Then 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}'."$ Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage) Log(errorMessage)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteQuery (V1)", errorMessage, DB, queryName, Null) Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteQuery (V1)", errorMessage, DB, queryName, Null)
SendPlainTextError(resp, 400, errorMessage) SendPlainTextError(resp, 400, errorMessage)
Return "error" Return "error"
End If End If
' <<< FIN NUEVA VALIDACIÓN >>> ' <<< FIN NUEVA VALIDACIÓN >>>
' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA (V1) >>> ' <<< 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) Dim rs As ResultSet = con.ExecQuery2(theSql, validationResult.ParamsToExecute)
' <<< FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA (V1) >>> ' <<< 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 jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount 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. ' Escribe la cabecera de la respuesta V1.
WriteObject(Main.VERSION, out) WriteObject(Main.VERSION, out)
WriteObject("query", out) WriteObject("query", out)
WriteInt(rs.ColumnCount, out) WriteInt(rs.ColumnCount, out)
' Escribe los nombres de las columnas. ' Escribe los nombres de las columnas.
For i = 0 To cols - 1 For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out) WriteObject(rs.GetColumnName(i), out)
Next Next
' Itera sobre las filas del resultado. ' Itera sobre las filas del resultado.
Do While rs.NextRow And limit > 0 Do While rs.NextRow And limit > 0
WriteByte(1, out) ' Escribe un byte '1' para indicar que viene una fila. WriteByte(1, out) ' Escribe un byte '1' para indicar que viene una fila.
' Itera sobre las columnas de la fila. ' Itera sobre las columnas de la fila.
For i = 0 To cols - 1 For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1)) Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
' Maneja los tipos de datos binarios de forma especial. ' Maneja los tipos de datos binarios de forma especial.
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out) WriteObject(rs.GetBlob2(i), out)
Else Else
' Escribe el valor de la columna. ' Escribe el valor de la columna.
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out) WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If End If
Next Next
limit = limit - 1 limit = limit - 1
Loop Loop
' Escribe un byte '0' para indicar el fin de las filas. ' Escribe un byte '0' para indicar el fin de las filas.
WriteByte(0, out) WriteByte(0, out)
out.Close out.Close
rs.Close rs.Close
Return "query: " & queryName Return "query: " & queryName
End Sub End Sub
' Escribe un único byte en el stream de salida. ' Escribe un único byte en el stream de salida.
Private Sub WriteByte(value As Byte, out As OutputStream) 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 End Sub
' Serializador principal para el protocolo V1. Escribe un objeto al stream. ' Serializador principal para el protocolo V1. Escribe un objeto al stream.
Private Sub WriteObject(o As Object, out As OutputStream) Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte Dim data() As Byte
' Escribe un byte de tipo seguido de los datos. ' Escribe un byte de tipo seguido de los datos.
If o = Null Then If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1) out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1) out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o)) data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1) out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o)) data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1) out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o)) data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1) out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o)) data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1) out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o)) data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1) out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o Dim b As Boolean = o
Dim data(1) As Byte Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0 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) Else If GetType(o) = "[B" Then ' Si el objeto es un array de bytes (BLOB)
data = o data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1) out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
' Escribe la longitud de los datos antes de los datos mismos. ' Escribe la longitud de los datos antes de los datos mismos.
WriteInt(data.Length, out) WriteInt(data.Length, out)
Else ' Trata todo lo demás como un String Else ' Trata todo lo demás como un String
out.WriteBytes(Array As Byte(T_STRING), 0, 1) out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8") data = bc.StringToBytes(o, "UTF8")
' Escribe la longitud del string antes del string. ' Escribe la longitud del string antes del string.
WriteInt(data.Length, out) WriteInt(data.Length, out)
End If End If
' Escribe los bytes del dato. ' Escribe los bytes del dato.
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length) If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub End Sub
' Deserializador principal para el protocolo V1. Lee un objeto del stream. ' Deserializador principal para el protocolo V1. Lee un objeto del stream.
Private Sub ReadObject(In As InputStream) As Object Private Sub ReadObject(In As InputStream) As Object
' Lee el primer byte para determinar el tipo de dato. ' Lee el primer byte para determinar el tipo de dato.
Dim data(1) As Byte Dim data(1) As Byte
In.ReadBytes(data, 0, 1) In.ReadBytes(data, 0, 1)
Select data(0) Select data(0)
Case T_NULL Case T_NULL
Return Null Return Null
Case T_SHORT Case T_SHORT
Dim data(2) As Byte Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0) Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT Case T_INT
Dim data(4) As Byte Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0) Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG Case T_LONG
Dim data(8) As Byte Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0) Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT Case T_FLOAT
Dim data(4) As Byte Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0) Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE Case T_DOUBLE
Dim data(8) As Byte Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0) Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN Case T_BOOLEAN
Dim b As Byte = ReadByte(In) Dim b As Byte = ReadByte(In)
Return b = 1 Return b = 1
Case T_BLOB Case T_BLOB
' Lee la longitud, luego lee esa cantidad de bytes. ' Lee la longitud, luego lee esa cantidad de bytes.
Dim len As Int = ReadInt(In) Dim len As Int = ReadInt(In)
Dim data(len) As Byte Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length) Return ReadBytesFully(In, data, data.Length)
Case Else ' T_STRING Case Else ' T_STRING
' Lee la longitud, luego lee esa cantidad de bytes y los convierte a string. ' Lee la longitud, luego lee esa cantidad de bytes y los convierte a string.
Dim len As Int = ReadInt(In) Dim len As Int = ReadInt(In)
Dim data(len) As Byte Dim data(len) As Byte
ReadBytesFully(In, data, data.Length) ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8") Return BytesToString(data, 0, data.Length, "UTF8")
End Select End Select
End Sub End Sub
' Se asegura de leer exactamente la cantidad de bytes solicitada del stream. ' 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() Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int Dim count = 0, Read As Int
' Sigue leyendo en un bucle hasta llenar el buffer, por si los datos llegan en partes. ' Sigue leyendo en un bucle hasta llenar el buffer, por si los datos llegan en partes.
Do While count < Len And Read > -1 Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count) Read = In.ReadBytes(Data, count, Len - count)
count = count + Read count = count + Read
Loop Loop
Return Data Return Data
End Sub End Sub
' Escribe un entero (4 bytes) en el stream. ' Escribe un entero (4 bytes) en el stream.
Private Sub WriteInt(i As Int, out As OutputStream) Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i)) data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length) out.WriteBytes(data, 0, data.Length)
End Sub End Sub
' Lee un entero (4 bytes) del stream. ' Lee un entero (4 bytes) del stream.
Private Sub ReadInt(In As InputStream) As Int Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0) Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub End Sub
' Lee un solo byte del stream. ' Lee un solo byte del stream.
Private Sub ReadByte(In As InputStream) As Byte Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte Dim data(1) As Byte
In.ReadBytes(data, 0, 1) In.ReadBytes(data, 0, 1)
Return data(0) Return data(0)
End Sub End Sub
' Lee una lista de objetos del stream (protocolo V1). ' Lee una lista de objetos del stream (protocolo V1).
Private Sub ReadList(in As InputStream) As List Private Sub ReadList(in As InputStream) As List
' Primero lee la cantidad de elementos en la lista. ' Primero lee la cantidad de elementos en la lista.
Dim len As Int = ReadInt(in) Dim len As Int = ReadInt(in)
Dim l1 As List Dim l1 As List
l1.Initialize l1.Initialize
' Luego lee cada objeto uno por uno y lo añade a la lista. ' Luego lee cada objeto uno por uno y lo añade a la lista.
For i = 0 To len - 1 For i = 0 To len - 1
l1.Add(ReadObject(in)) l1.Add(ReadObject(in))
Next Next
Return l1 Return l1
End Sub End Sub
'#end If ' Fin del bloque de compilación condicional para VERSION1 '#end If ' Fin del bloque de compilación condicional para VERSION1

7
DBHandlerJSON.bas
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 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 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 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 --- 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) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return ' Salida temprana. Return ' Salida temprana.
End If 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. 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 --- ' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
Else Else
Dim ErrorMsg As String = "Parámetro 'exec' inválido. '" & execType & "' no es un valor permitido." Dim ErrorMsg As String = "Parámetro 'exec' inválido. '" & execType & "' no es un valor permitido."
@@ -201,7 +202,6 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log 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. ' El flujo continúa hasta la limpieza final si no hay un Return explícito.
End If End If
Catch ' --- CATCH: Maneja errores generales de ejecución o de SQL/JSON --- Catch ' --- CATCH: Maneja errores generales de ejecución o de SQL/JSON ---
Log(LastException) ' Registra la excepción completa en el log. Log(LastException) ' Registra la excepción completa en el log.
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", LastException.Message, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo 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. 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. ' Llama a la subrutina centralizada para registrar el rendimiento y limpiar recursos.
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
End Sub End Sub
' --- NUEVA SUBRUTINA: Centraliza el logging de rendimiento y la limpieza de recursos --- ' --- NUEVA SUBRUTINA: Centraliza el logging de rendimiento y la limpieza de recursos ---

639
Manager.bas
View File

@@ -2,7 +2,7 @@
Group=Default Group Group=Default Group
ModulesStructureVersion=1 ModulesStructureVersion=1
Type=Class Type=Class
Version=8.8 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
' Módulo de clase: Manager ' Módulo de clase: Manager
' Este handler proporciona un panel de administración web para el servidor jRDC2-Multi. ' 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. ' 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. ' 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. ' 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) Sub Handle(req As ServletRequest, resp As ServletResponse)
' --- 1. Bloque de Seguridad: Autenticación de Usuario --- ' --- 1. Bloque de Seguridad (sin cambios) ---
' 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.
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then
resp.SendRedirect("/login") resp.SendRedirect("/login")
Return ' Termina la ejecución si no está autorizado. Return
End If End If
' Obtiene el comando solicitado de los parámetros de la URL (ej. "?command=reload").
Dim Command As String = req.GetParameter("command") 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}"$) ' --- 2. Servidor de la Página Principal ---
' Si NO se especifica un comando, servimos la página principal del manager desde la carpeta 'www'.
' --- MANEJO ESPECIAL PARA SNAPSHOT --- If Command = "" Then
' El comando "snapshot" no devuelve HTML, sino una imagen. Lo manejamos por separado al principio. Try
If Command = "snapshot" Then resp.ContentType = "text/html; charset=utf-8"
' Try resp.Write(File.ReadString(File.DirApp, "www/manager.html"))
' resp.ContentType = "image/png" Catch
' Dim robot, toolkit As JavaObject resp.SendError(500, "Error: No se pudo encontrar el archivo principal del panel (www/manager.html). " & LastException.Message)
' robot.InitializeNewInstance("java.awt.Robot", Null) End Try
' toolkit.InitializeStatic("java.awt.Toolkit") Return
' 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.
End If End If
' --- FIN DE MANEJO ESPECIAL ---
' Para todos los demás comandos, construimos la página HTML de respuesta. ' --- 3. Manejo de Comandos como API ---
resp.ContentType = "text/html" ' Establece el tipo de contenido como HTML. ' La variable 'j' (JSONGenerator) está en Class_Globals
Dim sb As StringBuilder ' Usamos StringBuilder para construir eficientemente el HTML.
sb.Initialize
' --- Estilos y JavaScript (igual que antes) --- Select Command.ToLowerCase
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 --- ' --- Comandos que devuelven JSON ---
sb.Append("<h1>Panel de Administración jRDC</h1>") Case "getstats"
sb.Append($"<p>Bienvenido, <strong>${req.GetSession.GetAttribute("username")}</strong></p>"$) resp.ContentType = "application/json; charset=utf-8"
' --- 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
' 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
' 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.
Dim allPoolStats As Map Dim allPoolStats As Map
allPoolStats.Initialize allPoolStats.Initialize
' Iteramos sobre cada clave de base de datos que tenemos configurada (DB1, DB2, etc.).
For Each dbKey As String In Main.listaDeCP 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)
Dim connector As RDCConnector = Main.Connectors.Get(dbKey).As(RDCConnector) If connector.IsInitialized Then
allPoolStats.Put(dbKey, connector.GetPoolStats)
' Si el conector no está inicializado (lo cual no debería ocurrir si Main.AppStart funcionó), Else
' registramos un error y pasamos al siguiente. allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado"))
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 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 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) j.Initialize(allPoolStats)
resp.Write(j.ToString)
Return
' Añadimos la representación JSON de las estadísticas al StringBuilder para la respuesta HTML. Case "slowqueries"
sb.Append(j.ToString) resp.ContentType = "application/json; charset=utf-8"
Else Dim results As List
sb.Append("El mapa de conexiones GlobalParameters.mpTotalConnections no está inicializado.") results.Initialize
End If Try
End If ' 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
' ### FIN DE TU LÓGICA DE COMANDOS ### 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
' --- Cerramos la página y la enviamos --- ' La tabla existe, procedemos con la consulta original
sb.Append("</div><p class='logout'><a href='/logout'>Cerrar Sesión</a> | <a href=# onclick='toggleForm()'>Cambiar Contraseña</a></p></body></html>") Dim oneHourAgoMs As Long = DateTime.Now - 3600000
resp.Write(sb.ToString) 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"$)
If GlobalParameters.mpLogs.IsInitialized Then GlobalParameters.mpLogs.Put(Command, "Manager : " & Command & " - Time : " & DateTime.Time(DateTime.Now)) 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 End Sub

1
ParameterValidationUtils.bas
View File

@@ -50,6 +50,7 @@ Public Sub ValidateAndAdjustParameters (CommandName As String, DBKey As String,
res.Success = True res.Success = True
Dim WarningMsg As String = $"ADVERTENCIA: Se recibieron más parámetros de los esperados para "${CommandName}" (DB: ${DBKey}). Se esperaban ${expectedParams} y se recibieron ${receivedParamsSize}. Se ajustó la lista de parámetros a ${expectedParams} elementos."$ Dim WarningMsg As String = $"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(WarningMsg)
Log("Cache: " & Main.LOG_CACHE_THRESHOLD & "|" & Main.ErrorLogCache.Size)
Main.LogServerError("ADVERTENCIA", "ParameterValidationUtils.ValidateAndAdjustParameters", WarningMsg, DBKey, CommandName, Null) ' <-- Nuevo Log [6] Main.LogServerError("ADVERTENCIA", "ParameterValidationUtils.ValidateAndAdjustParameters", WarningMsg, DBKey, CommandName, Null) ' <-- Nuevo Log [6]
Else Else
' Si la tolerancia NO está habilitada, esto es un error crítico. ' Si la tolerancia NO está habilitada, esto es un error crítico.

26
jRDC_Multi.b4j
View File

@@ -32,10 +32,11 @@ Library8=jsql
Library9=bcrypt Library9=bcrypt
Module1=Cambios Module1=Cambios
Module10=Manager Module10=Manager
Module11=ParameterValidationUtils Module11=Manager0
Module12=ping Module12=ParameterValidationUtils
Module13=RDCConnector Module13=ping
Module14=TestHandler Module14=RDCConnector
Module15=TestHandler
Module2=ChangePassHandler Module2=ChangePassHandler
Module3=DBHandlerB4X Module3=DBHandlerB4X
Module4=DBHandlerJSON Module4=DBHandlerJSON
@@ -46,7 +47,7 @@ Module8=LoginHandler
Module9=LogoutHandler Module9=LogoutHandler
NumberOfFiles=10 NumberOfFiles=10
NumberOfLibraries=9 NumberOfLibraries=9
NumberOfModules=14 NumberOfModules=15
Version=10.3 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
'Non-UI application (console / server application) 'Non-UI application (console / server application)
@@ -55,7 +56,7 @@ Version=10.3
#CommandLineArgs: #CommandLineArgs:
#MergeLibraries: True #MergeLibraries: True
' VERSION 5.09.16.2 ' VERSION 5.09.17
'########################################################################################################### '###########################################################################################################
'###################### PULL ############################################################# '###################### PULL #############################################################
'Ctrl + click ide://run?file=%WINDIR%\System32\cmd.exe&Args=/c&Args=git&Args=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 QueryLogCache As List ' Cache para los logs de rendimiento (query_logs)
Public ErrorLogCache As List ' Cache para los logs de errores y advertencias 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 Dim logger As Boolean
End Sub End Sub
@@ -133,6 +134,7 @@ End Sub
Sub AppStart (Args() As String) Sub AppStart (Args() As String)
#if DEBUG #if DEBUG
logger = True logger = True
LOG_CACHE_THRESHOLD = 10
#else #else
logger = False logger = False
#End If #End If
@@ -178,7 +180,7 @@ Sub AppStart (Args() As String)
Log($"Main.AppStart: Conector 'DB1' inicializado exitosamente en puerto: ${srvr.Port}"$) Log($"Main.AppStart: Conector 'DB1' inicializado exitosamente en puerto: ${srvr.Port}"$)
' Lógica de Logs para DB1 (Fuente principal de configuración) ' 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) Dim isEnabled As Boolean = (enableLogsSetting = 1)
SQLiteLoggingStatusByDB.Put("DB1", isEnabled) ' Guardar el estado SQLiteLoggingStatusByDB.Put("DB1", isEnabled) ' Guardar el estado
@@ -661,8 +663,16 @@ End Sub
Sub borraArribaDe15000Logs 'ignore Sub borraArribaDe15000Logs 'ignore
If IsAnySQLiteLoggingEnabled Then ' Solo ejecutar si al menos una DB requiere logs. 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.") 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 )") 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;") SQL1.ExecNonQuery("vacuum;")
Else Else
' Si IsAnySQLiteLoggingEnabled es False, el Timer no debería estar activo. ' Si IsAnySQLiteLoggingEnabled es False, el Timer no debería estar activo.

9
jRDC_Multi.b4j.meta
View File

@@ -5,6 +5,7 @@ ModuleBookmarks11=
ModuleBookmarks12= ModuleBookmarks12=
ModuleBookmarks13= ModuleBookmarks13=
ModuleBookmarks14= ModuleBookmarks14=
ModuleBookmarks15=
ModuleBookmarks2= ModuleBookmarks2=
ModuleBookmarks3= ModuleBookmarks3=
ModuleBookmarks4= ModuleBookmarks4=
@@ -20,6 +21,7 @@ ModuleBreakpoints11=
ModuleBreakpoints12= ModuleBreakpoints12=
ModuleBreakpoints13= ModuleBreakpoints13=
ModuleBreakpoints14= ModuleBreakpoints14=
ModuleBreakpoints15=
ModuleBreakpoints2= ModuleBreakpoints2=
ModuleBreakpoints3= ModuleBreakpoints3=
ModuleBreakpoints4= ModuleBreakpoints4=
@@ -35,14 +37,15 @@ ModuleClosedNodes11=
ModuleClosedNodes12= ModuleClosedNodes12=
ModuleClosedNodes13= ModuleClosedNodes13=
ModuleClosedNodes14= ModuleClosedNodes14=
ModuleClosedNodes15=
ModuleClosedNodes2= ModuleClosedNodes2=
ModuleClosedNodes3=9,10,11,12,13,14,15,16 ModuleClosedNodes3=
ModuleClosedNodes4= ModuleClosedNodes4=
ModuleClosedNodes5= ModuleClosedNodes5=
ModuleClosedNodes6= ModuleClosedNodes6=
ModuleClosedNodes7= ModuleClosedNodes7=
ModuleClosedNodes8= ModuleClosedNodes8=
ModuleClosedNodes9= 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 SelectedBuild=0
VisibleModules=3,4,13,1,10,11,14,2 VisibleModules=3,4,14,1,10,12