[R-pkg-devel] socketConnection, delay when reading from

Ben Engbers ben@engber@ @end|ng |rom gm@||@com
Wed Dec 8 17:41:06 CET 2021


Hi Tomas,

I saw that the attached file is missing, I therefore have added it below.

In the examples in your reply from 11/27/21 8:05 PM, you use the command 
'socketSelect(list(con2))'.
I have replaced my Sys.sleep() command with 'socketSelect(list(conn))'.
Execution-time for all the tests has now been reduced to 1.5 seconds!

Thanx

Ben

Op 08-12-2021 om 12:40 schreef Tomas Kalibera:
> If you need more help from people on the list, it might be better to 
> send a small, but full complete example, so also with a server, so that 
> it is something people could run and reproduce.
> 
> Best
> Tomas
> 
>>
>> Ben

library("R6")
library("dplyr")
library("magrittr")
library("openssl")

Bsize <- 1024

SocketClass <- R6Class(
   "SocketClass",
   portable = TRUE,
   public = list(
     #' @description Initialize a new socket
     #' @param host,port,username,password Host-information and credentials
     initialize = function(host, port = 1984L, username, password) {
       private$CreateSocket(host, port, username, password)
     },
     #' @description When releasing the session-object, close the 
socketConnection
     finalize = function() {
       close(private$conn)
     },

     #' @description Write 1 byte to the socket
     #' @param Byte A  vector length 1
     write_Byte = function(Byte) {
       writeBin(Byte, private$conn)
       invisible(self)
     }
   ),

   private = list(
     conn = NULL,
     sendInput = function(input) {
       writeBin(input, private$conn)
       invisible(self)
     },
     CreateSocket = function(host, port = 1984L, username, password) {
       tryCatch(
         {conn <- private$conn <- socketConnection(
           host = "localhost", port,
           open = "w+b", server = FALSE, blocking = FALSE, encoding = 
"UTF-8")
         }, error = function(e) {
           stop("Cannot open the connection")
         }
       )
       response <- readBin_(conn) %>% rawToChar()
       splitted <-strsplit(response, "\\:")
       ifelse(length(splitted[[1]]) > 1,
              { realm <- splitted[[1]][1]
                code  <- paste(username, realm, password, sep=":")
                nonce <- splitted[[1]][2] },
              { code  <- password
                nonce <- splitted[[1]][1]}
             )
       code <- md5(paste(md5(code), nonce, sep = "")) %>% charToRaw()
       # send username + code
       auth <- c(charToRaw(username), as.raw(0x00), code, as.raw(0x00))
       writeBin(auth, private$conn)
       # Sys.sleep(.1)
       socketSelect(list(conn))
       Accepted <- readBin(conn, what = "raw", n = 1) == 0
       if (!Accepted) {
         close(private$conn)
         stop("Access denied")
       }
     }
   )
)

done <- function(rd, total_length) {
   if (total_length == 0) {
     finish <- FALSE
   } else {
     finish <- ifelse(length(rd == Bsize), FALSE, TRUE)
   }
   return(finish)
}
readBin_ <- function(conn) {
   total_read <- rd <- as.raw(c())
   while(!done(rd, length(total_read))) {
     rd <- readBin(conn, "raw", Bsize)
     total_read %<>% c(rd)
     }
   return(total_read)
}

test <- SocketClass$new(host, port = 1984L, "admin", "admin")



More information about the R-package-devel mailing list