#' A ldap_login function
#'
#' This function allows you to verify a username and password on an LDAP server.
#' @param input Shiny input object passed from the server.
#' @param output Shiny output object passed from the server.
#' @param ui_name the name of the UI output. That is, put `uiOutput(ui_name)` where
#' you want the Login Dialog in `ui.R`.
#' @param modal boolean (TRUE / FALSE) indicating the form mode.
#' @param ldap.url ldap server url
#' @param ldap.dc ldap server DC
#' @param ldap.filtro 'sAMAccountName', # for AD LDAP Server
#' @param ldap.dominio ldap server domain
#' @param ldap.campos ldap fields to get
#' @param label.user user label
#' @param label.pass = password label
#' @param label.button.go = login button label
#' @param label.button.cancel = cancel button label
#' @param label.button.modal = modal button label
#' @param label.title = Login dialog title
#' @param show.button.cancel = Show the cancel button
#' @param show.button.modal = Show the modal button
#' @param msg.list = Message list
#' @param callback.return a function called when the user click a response button. This function can
#' return a error message.
#'
#'
#' @keywords ldap
#' @export
#' @examples
#' shinyldap::ldap_login(input, output,
#' ui_name = 'ui_login',
#' modal = TRUE,
#' ldap.url = secrets.ldap.url,
#' ldap.dc = secrets.ldap.dc,
#' ldap.filtro = secrets.ldap.filtro,
#' ldap.dominio = secrets.ldap.dominio,
#' ldap.campos = secrets.ldap.campos,
#' label.user = 'User',
#' label.pass = 'Password',
#' label.button.go = 'Login',
#' label.button.cancel = 'Cancel',
#' label.button.modal = 'Close',
#' label.title = 'Shiny LDAP Login',
#' show.button.cancel = TRUE,
#' show.button.modal = FALSE,
#' msg.list = list(empty = 'These fields cannot be empty!', time = 'Please! Wait a moment before login again.' ),
#' callback.return = ldap.callback.return)
ldap_login <- function(input, output, ui_name, modal = FALSE,
ldap.url,
ldap.dc,
ldap.filtro = 'sAMAccountName', # for AD LDAP Server
ldap.dominio,
ldap.campos,
label.user = 'User',
label.pass = 'Password',
label.button.go = 'Login',
label.button.cancel = 'Cancel',
label.button.modal = 'Close',
label.title = 'Shiny LDAP Login',
show.button.cancel = TRUE,
show.button.modal = FALSE,
msg.list = list(empty = 'These fields cannot be empty!',
time = 'Please! Wait a moment before login again.'),
callback.return = function (result) {}
) {
message('* R Shiny Ldap function v.: ', '0.0.2.4', ' - - - - ', Sys.time(), ' - - - -')
message('Ldap.url: ', ldap.url)
mod.active <- shiny::reactiveVal(FALSE)
mod.timer <- shiny::reactiveVal(10)
#TODO verificar todos os parametros
if (ldap.url=='') {
stop ('You need to inform ldap.url like "https://ldap.domain.com:port"')
}
if (ldap.dc=='') {
stop ('You need to inform ldap.dc like "dc=ldapserver,dc=com"')
}
if (ldap.filtro=='') {
stop ('You need to inform ldap.filtro like "sAMAccountName"')
}
if (ldap.dominio =='') {
stop ('You need to inform ldap.dominio like "intranet"')
}
if (length(ldap.campos) == 0) {
stop ("You need to inform ldap.campos like c('dn:', 'cn:', 'sn:', 'title:','displayName:', 'name:', 'employeeID:', 'sAMAccountName:'")
}
if (!all(grepl(c(':'), ldap.campos))) {
stop ('All ldap.campos elements must have ":" in name')
}
# VARS
comando <- 'ldapsearch -H ldap_url -x -D "ldap_dominio\\ldap_user" -w ldap_pass -b "ldap_dc" "(&(ldap_filtro=ldap_user))"'
# prog
ui_txtUser <- paste0(ui_name, 'txtuser')
ui_txtPass <- paste0(ui_name, 'txtsenha')
ui_actBtn <- paste0(ui_name,'_GO')
ui_closeBtn <- paste0(ui_name,'_CLOSE')
ui_txtInfo <- paste0(ui_name,'txtInfo')
ui_txtclock <- paste0(ui_name,'txtclock')
result <- list()
result$ldap <- FALSE
result$btn <-''
result$table_data <-''
result$user <- ''
result$err <- FALSE
temLdap = temComando('ldapsearch')
result$ldap <- temLdap
cat(file=stderr(), "ldapsearch: ", temLdap,'\n')
if (!temLdap) {
# No LDAPSEARCH COMMAND
# stop ('You need to install LDAP-UTILS (ldapsearch command)')
# just test
}
modal_clock <- function() {
}
modal_ui <- function(show.bt = TRUE) {
shiny::isolate({
ui_act <- shiny::actionButton(ui_actBtn, label.button.go)
ui_clo <- shiny::actionButton(ui_closeBtn, label.button.cancel)
ui_mod <- shiny::modalButton(label.button.modal)
ui_u.1 <- shiny::textInput(ui_txtUser,label.user,"")
ui_u.2 <- shiny::passwordInput(ui_txtPass,label.pass,"")
})
ui_clock <- ''
col1 <- 7
col2 <- 5
if (!show.bt) {
shiny::isolate({
ui_act <- ''
ui_clo <- ''
ui_mod <- ''
ui_u.1 <- shiny::h2(msg.list$time, align = 'CENTER')
col1 <- 12
})
#ui_clock <- shiny::column(1, #5
# shiny::h2(
# shiny::textOutput(ui_txtclock), align = 'CENTER', style = "color:red"
# ))
ui_u.2 <- shiny::h2(shiny::textOutput(ui_txtclock), align = 'CENTER', style = "color:red")
}
if (!show.button.cancel) {ui_clo <- shiny::div()}
if (!show.button.modal) {ui_mod <- shiny::div()}
shiny::modalDialog(title = label.title,
shiny::div(
shiny::fluidPage(
shiny::fluidRow(
shiny::column(col1, #7
ui_u.1,
ui_u.2),
ui_clock
)
)),
shiny::h2( shiny::verbatimTextOutput(ui_txtInfo), style = "color:red", ''),
footer = shiny::column(
ui_act,
ui_clo,
ui_mod,
width = 12)
)
}
if (modal) {
shiny::showModal(modal_ui())
}
# functions
#consulta LDAP
consultaLdap <- function(usuario, senha) {
newC <- sub('ldap_url', ldap.url, comando)
newC <- sub('ldap_dominio', ldap.dominio,newC)
newC <- gsub('ldap_user',usuario,newC)
newC <- sub('ldap_pass',senha,newC)
newC <- sub('ldap_filtro',ldap.filtro,newC)
newC <- sub('ldap_dc',ldap.dc,newC)
#TODO passwords with space \ " '
newC <- c('-H',ldap.url,
'-x', '-D',paste0(usuario,'@', ldap.dominio),
'-w', senha,
'-b', ldap.dc,
paste0('(&(sAMAccountName=', usuario, '))'))
tmp <- processx::run('ldapsearch', newC, error_on_status = FALSE)
return (tmp)
}
#userLdap
userLdap <- function(resLdap) {
cat(file=stderr(),"resLdap: ", resLdap, "\n")
if (!is.numeric(resLdap)) {
dados <- unlist(strsplit(resLdap, split = '\n'))
dt_usuario <- unique (grep(paste(ldap.campos,collapse="|"), dados, value=TRUE))
message('dt_usuario: ', dt_usuario)
lista_sep <- separaTxt(dt_usuario)
message('lista_SEP')
print(lista_sep)
return (lista_sep)
} else {
return (resLdap)
}
}
errosLdap <- function (erro) {
lista_err <- c('525','52e','52f','530','531','532','533','568','701','773','775')
e <- list()
e$e525 <- 'Entry does not exist.'
e$e52e <- 'Username is valid but password/credential is invalid.'
e$e52f -> 'Account Restrictions are preventing this user from signing in.'
e$e530 -> 'Time Restriction:Entry logon time restriction violation'
e$e531 <- 'Device Restriction:Entry not allowed to log on to this computer.'
e$e532 <- 'Password Expiration: Entry password has expired LDAP User-Account-Control Attribute - ERROR_PASSWORD_EXPIRED'
e$e533 -> 'Administratively Disabled: LDAP User-Account-Control Attribute - ACCOUNTDISABLE'
e$e568 <- "During a logon attempt, the user's security context accumulated too many security Identifiers. (ie Group-AD)"
e$e701 <- 'LDAP Password Expiration: User-Account-Control Attribute - ACCOUNTEXPIRED'
e$e773 -> "Password Expiration: Entry's password must be changed before logging on LDAP pwdLastSet: value of 0 indicates admin-required password change - MUST_CHANGE_PASSWD"
e$e775 -> 'Intruder Detection:Entry is currently locked out and may not be logged on to LDAP User-Account-Control Attribute - LOCKOUT'
e$e999 -> "Undefined error!"
# "Can't contact LDAP server"
lista2 <- paste0('data ',lista_err,',')
ret <- list(cod = 'nda', msg = 'nda')
for (i in lista2) {
#message('ldap-i: ',i)
if (any(grep(i,erro))) {
po <- grep(i,lista2)
ret$cod <- lista_err[po]
ret$msg <- unlist(e[paste0('e',ret$cod)])
message('return errorLdap: ', ret$msg)
return (ret)
}
}
ret$msg <- e$e999
ret$cod <- 999
return (ret)
}
go_click <- shiny::observeEvent(input[[ui_actBtn]], {
message('go_click')
i.user <- input[[ui_txtUser]]
i.pass <- input[[ui_txtPass]]
if ((i.user == '') | (i.pass == '')) {
output[[ui_txtInfo]] <- shiny::renderPrint(paste0(msg.list$empty));
return (TRUE)
}
result$btn <- 'GO'
result$user <- i.user
shiny::isolate({
result$err.cod <- 'nda'
result$err.msg <- 'nda'
})
if (temLdap) {
dadosRaw <- consultaLdap(i.user,i.pass)
message('status: ',dadosRaw$status)
message('stdout: ',dadosRaw$stdout)
message('stderr: ',dadosRaw$stderr)
result$status <- dadosRaw$status
result$data <- dadosRaw$stdout
result$stderr <- dadosRaw$stderr
result$timeout <- dadosRaw$timeout
result$table_data <- userLdap(result$data)
if (dadosRaw$status == 0) {
result$err.msg <- 'ok'
result$err.cod <- 0
} else {
tmp <- errosLdap(dadosRaw$stderr)
result$err.msg <- tmp$msg
result$err.cod <- tmp$cod
}
} else {
result$data <- 'LDAP not found!'
result$err.cod <- '100'
result$err.msg <- result$data
result$status <- '100'
}
chama <- callback.return(result)
chama.msg <- unlist(chama$msg)
chama.wait <- unlist(chama$wait)
message("callback_chama: ", chama.msg)
message("* WAIT: ", chama.wait)
if (modal) {
if (chama.msg == 'nda') {
shiny::removeModal()
message("removeModal: ", 'modal' )
} else {
message("output: ", 'ui_txtInfo' )
output[[ui_txtInfo]] <- shiny::renderPrint(paste0(chama$msg));
if (chama.wait>0) {
mod.timer(chama.wait)
shiny::showModal(modal_ui(FALSE))
mod.active(TRUE)
}
}
}
})
#time counter
shiny::observe({
shiny::invalidateLater(1001, shiny::getDefaultReactiveDomain()) # session
shiny::isolate({
if(mod.active()) {
mod.timer(mod.timer()-1)
if(mod.timer()<1) {
mod.active(FALSE)
if (modal) {
shiny::showModal(modal_ui())
}
}
}
})
})
if (modal) {
output[[ui_txtclock]] <- shiny::renderText(format(as.difftime(mod.timer(), units="secs")))
}
close_click <- shiny::observeEvent(input[[ui_closeBtn]], {
message('close_click')
result$btn <- 'CANCEL'
result$err.cod <- 0
chama <- callback.return(result)
if (modal) {shiny::removeModal()}
})
# LOGIN UI
login_ui <- shiny::renderUI({
message('login_ui')
shiny::fluidPage(
shiny::titlePanel(label.title), # 'Login Shiny'
shiny::fluidRow(shiny::textInput(ui_txtUser,label.user,""), #USER
shiny::passwordInput(ui_txtPass,label.pass,"")), #PASS
shiny::actionButton(ui_actBtn, label.button.go), #BTN GO
shiny::actionButton(ui_closeBtn, label.button.cancel),
shiny::h2( shiny::verbatimTextOutput(ui_txtInfo),
'')
)
})
if (modal) {
login_ui <- shiny::renderUI('')
}
#build LOGIN UI
output[[ui_name]] <- login_ui
# THE END
return(result)
}
# functions extenal
#tem comando
temComando <- function(comando) {
tmp <- Sys.which(comando)
return (!(paste0(tmp)==''))
}
# split txt
separaTxt <- function(info) {
lst <- list()
for (i in info) {
elem <- strsplit(i,': ')[[1]]
lst[elem[1]] <- elem[2]
}
ret <- lst
return (ret)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.