Create a gist now

Instantly share code, notes, and snippets.

@withr /server.R
Last active May 18, 2018

What would you like to do?
Encrypt password with md5 for Shiny-app.
library(shiny)
library(datasets)
Logged = FALSE;
PASSWORD <- data.frame(Brukernavn = "withr", Passord = "25d55ad283aa400af464c76d713c07ad")
# Define server logic required to summarize and view the selected dataset
shinyServer(function(input, output) {
source("www/Login.R", local = TRUE)
observe({
if (USER$Logged == TRUE) {
output$obs <- renderUI({
sliderInput("obs", "Number of observations:",
min = 10000, max = 90000,
value = 50000, step = 10000)
})
output$distPlot <- renderPlot({
dist <- NULL
dist <- rnorm(input$obs)
hist(dist, breaks = 100, main = paste("Your password:", input$passwd))
})
}
})
})
shinyUI(bootstrapPage(
# Add custom CSS & Javascript;
tagList(
tags$head(
tags$link(rel="stylesheet", type="text/css",href="style.css"),
tags$script(type="text/javascript", src = "md5.js"),
tags$script(type="text/javascript", src = "passwdInputBinding.js")
)
),
## Login module;
div(class = "login",
uiOutput("uiLogin"),
textOutput("pass")
),
div(class = "span4", uiOutput("obs")),
div(class = "span8", plotOutput("distPlot"))
))
#### Log in module ###
USER <- reactiveValues(Logged = Logged)
passwdInput <- function(inputId, label) {
tagList(
tags$label(label),
tags$input(id = inputId, type="password", value="")
)
}
output$uiLogin <- renderUI({
if (USER$Logged == FALSE) {
wellPanel(
textInput("userName", "User Name:"),
passwdInput("passwd", "Pass word:"),
br(),
actionButton("Login", "Log in")
)
}
})
output$pass <- renderText({
if (USER$Logged == FALSE) {
if (!is.null(input$Login)) {
if (input$Login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
Id.username <- which(PASSWORD$Brukernavn == Username)
Id.password <- which(PASSWORD$Passord == Password)
if (length(Id.username) > 0 & length(Id.password) > 0) {
if (Id.username == Id.password) {
USER$Logged <- TRUE
}
} else {
"User name or password failed!"
}
}
}
}
})
// Downloaded from: http://www.myersdaily.org/joseph/javascript/md5.js;
function md5cycle(x, k) {
var a = x[0], b = x[1], c = x[2], d = x[3];
a = ff(a, b, c, d, k[0], 7, -680876936);
d = ff(d, a, b, c, k[1], 12, -389564586);
c = ff(c, d, a, b, k[2], 17, 606105819);
b = ff(b, c, d, a, k[3], 22, -1044525330);
a = ff(a, b, c, d, k[4], 7, -176418897);
d = ff(d, a, b, c, k[5], 12, 1200080426);
c = ff(c, d, a, b, k[6], 17, -1473231341);
b = ff(b, c, d, a, k[7], 22, -45705983);
a = ff(a, b, c, d, k[8], 7, 1770035416);
d = ff(d, a, b, c, k[9], 12, -1958414417);
c = ff(c, d, a, b, k[10], 17, -42063);
b = ff(b, c, d, a, k[11], 22, -1990404162);
a = ff(a, b, c, d, k[12], 7, 1804603682);
d = ff(d, a, b, c, k[13], 12, -40341101);
c = ff(c, d, a, b, k[14], 17, -1502002290);
b = ff(b, c, d, a, k[15], 22, 1236535329);
a = gg(a, b, c, d, k[1], 5, -165796510);
d = gg(d, a, b, c, k[6], 9, -1069501632);
c = gg(c, d, a, b, k[11], 14, 643717713);
b = gg(b, c, d, a, k[0], 20, -373897302);
a = gg(a, b, c, d, k[5], 5, -701558691);
d = gg(d, a, b, c, k[10], 9, 38016083);
c = gg(c, d, a, b, k[15], 14, -660478335);
b = gg(b, c, d, a, k[4], 20, -405537848);
a = gg(a, b, c, d, k[9], 5, 568446438);
d = gg(d, a, b, c, k[14], 9, -1019803690);
c = gg(c, d, a, b, k[3], 14, -187363961);
b = gg(b, c, d, a, k[8], 20, 1163531501);
a = gg(a, b, c, d, k[13], 5, -1444681467);
d = gg(d, a, b, c, k[2], 9, -51403784);
c = gg(c, d, a, b, k[7], 14, 1735328473);
b = gg(b, c, d, a, k[12], 20, -1926607734);
a = hh(a, b, c, d, k[5], 4, -378558);
d = hh(d, a, b, c, k[8], 11, -2022574463);
c = hh(c, d, a, b, k[11], 16, 1839030562);
b = hh(b, c, d, a, k[14], 23, -35309556);
a = hh(a, b, c, d, k[1], 4, -1530992060);
d = hh(d, a, b, c, k[4], 11, 1272893353);
c = hh(c, d, a, b, k[7], 16, -155497632);
b = hh(b, c, d, a, k[10], 23, -1094730640);
a = hh(a, b, c, d, k[13], 4, 681279174);
d = hh(d, a, b, c, k[0], 11, -358537222);
c = hh(c, d, a, b, k[3], 16, -722521979);
b = hh(b, c, d, a, k[6], 23, 76029189);
a = hh(a, b, c, d, k[9], 4, -640364487);
d = hh(d, a, b, c, k[12], 11, -421815835);
c = hh(c, d, a, b, k[15], 16, 530742520);
b = hh(b, c, d, a, k[2], 23, -995338651);
a = ii(a, b, c, d, k[0], 6, -198630844);
d = ii(d, a, b, c, k[7], 10, 1126891415);
c = ii(c, d, a, b, k[14], 15, -1416354905);
b = ii(b, c, d, a, k[5], 21, -57434055);
a = ii(a, b, c, d, k[12], 6, 1700485571);
d = ii(d, a, b, c, k[3], 10, -1894986606);
c = ii(c, d, a, b, k[10], 15, -1051523);
b = ii(b, c, d, a, k[1], 21, -2054922799);
a = ii(a, b, c, d, k[8], 6, 1873313359);
d = ii(d, a, b, c, k[15], 10, -30611744);
c = ii(c, d, a, b, k[6], 15, -1560198380);
b = ii(b, c, d, a, k[13], 21, 1309151649);
a = ii(a, b, c, d, k[4], 6, -145523070);
d = ii(d, a, b, c, k[11], 10, -1120210379);
c = ii(c, d, a, b, k[2], 15, 718787259);
b = ii(b, c, d, a, k[9], 21, -343485551);
x[0] = add32(a, x[0]);
x[1] = add32(b, x[1]);
x[2] = add32(c, x[2]);
x[3] = add32(d, x[3]);
}
function cmn(q, a, b, x, s, t) {
a = add32(add32(a, q), add32(x, t));
return add32((a << s) | (a >>> (32 - s)), b);
}
function ff(a, b, c, d, x, s, t) {
return cmn((b & c) | ((~b) & d), a, b, x, s, t);
}
function gg(a, b, c, d, x, s, t) {
return cmn((b & d) | (c & (~d)), a, b, x, s, t);
}
function hh(a, b, c, d, x, s, t) {
return cmn(b ^ c ^ d, a, b, x, s, t);
}
function ii(a, b, c, d, x, s, t) {
return cmn(c ^ (b | (~d)), a, b, x, s, t);
}
function md51(s) {
txt = '';
var n = s.length,
state = [1732584193, -271733879, -1732584194, 271733878], i;
for (i=64; i<=s.length; i+=64) {
md5cycle(state, md5blk(s.substring(i-64, i)));
}
s = s.substring(i-64);
var tail = [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0];
for (i=0; i<s.length; i++)
tail[i>>2] |= s.charCodeAt(i) << ((i%4) << 3);
tail[i>>2] |= 0x80 << ((i%4) << 3);
if (i > 55) {
md5cycle(state, tail);
for (i=0; i<16; i++) tail[i] = 0;
}
tail[14] = n*8;
md5cycle(state, tail);
return state;
}
function md5blk(s) { /* I figured global was faster. */
var md5blks = [], i; /* Andy King said do it this way. */
for (i=0; i<64; i+=4) {
md5blks[i>>2] = s.charCodeAt(i)
+ (s.charCodeAt(i+1) << 8)
+ (s.charCodeAt(i+2) << 16)
+ (s.charCodeAt(i+3) << 24);
}
return md5blks;
}
var hex_chr = '0123456789abcdef'.split('');
function rhex(n)
{
var s='', j=0;
for(; j<4; j++)
s += hex_chr[(n >> (j * 8 + 4)) & 0x0F]
+ hex_chr[(n >> (j * 8)) & 0x0F];
return s;
}
function hex(x) {
for (var i=0; i<x.length; i++)
x[i] = rhex(x[i]);
return x.join('');
}
function md5(s) {
return hex(md51(s));
}
function add32(a, b) {
return (a + b) & 0xFFFFFFFF;
}
if (md5('hello') != '5d41402abc4b2a76b9719d911017c592') {
function add32(x, y) {
var lsw = (x & 0xFFFF) + (y & 0xFFFF),
msw = (x >> 16) + (y >> 16) + (lsw >> 16);
return (msw << 16) | (lsw & 0xFFFF);
}
}
jQuery(function($) {
// Password Input
var passwordInputBinding = new Shiny.InputBinding();
$.extend(passwordInputBinding, {
find: function(scope) {
return $(scope).find('input[type="password"]');
},
getId: function(el) {
return Shiny.InputBinding.prototype.getId.call(this, el) || el.name;
},
getValue: function(el) {
return md5(el.value);
},
setValue: function(el, value) {
el.value = value;
},
subscribe: function(el, callback) {
$(el).on('keyup.passwordInputBinding input.passwordInputBinding', function(event) {
callback(true);
});
$(el).on('change.passwordInputBinding', function(event) {
callback(false);
});
},
unsubscribe: function(el) {
$(el).off('.passwordInputBinding');
},
getRatePolicy: function() {
return {
policy: 'debounce',
delay: 250
};
}
});
Shiny.inputBindings.register(passwordInputBinding, 'shiny.passwordInput');
})
div.login {
text-align: left;
position:absolute;
top: 40%;
left: 50%;
margin-top: -100px;
margin-left: -150px;
}
div#pass {
text-align: left;
font-weight:bold;
padding-left:2px;
}
input#Password {
-webkit-text-security: disc;
}
body {
margin:1cm;
font-size: 12px;
}
.shiny-output-error {
visibility: hidden;
}
@victorfang

This comment has been minimized.

Show comment Hide comment
@victorfang

victorfang Mar 30, 2015

Thanks for this great example!
I'm trying to understand the encryption / authentication process. So I use package capture to observe the traffic from browser to server.
Surprising, when I inputted the user name / password, and hit submit, I only see some minimal WebSocket traffic w/ Base64 flying to the server which is less than the length of MD5 hash . I'm curious how did the encrypted password / username got send to the back end? thanks!

Thanks for this great example!
I'm trying to understand the encryption / authentication process. So I use package capture to observe the traffic from browser to server.
Surprising, when I inputted the user name / password, and hit submit, I only see some minimal WebSocket traffic w/ Base64 flying to the server which is less than the length of MD5 hash . I'm curious how did the encrypted password / username got send to the back end? thanks!

@mfost

This comment has been minimized.

Show comment Hide comment
@mfost

mfost Apr 9, 2015

This is really useful. Do you have a way to decrypt the passwords, or is there a way to temporarily store the password input before it gets passed to the encoder?

mfost commented Apr 9, 2015

This is really useful. Do you have a way to decrypt the passwords, or is there a way to temporarily store the password input before it gets passed to the encoder?

@Martin9384

This comment has been minimized.

Show comment Hide comment
@Martin9384

Martin9384 Sep 2, 2015

What is the password and user for this app? I tried to use it, but it always fails to log in.
Thanks

What is the password and user for this app? I tried to use it, but it always fails to log in.
Thanks

@fxi

This comment has been minimized.

Show comment Hide comment
@fxi

fxi Sep 17, 2015

@Martin9384 use your own password md5 hash.

Ex.

echo -n 1234 | md5sum

or in a javascript console with the function md5 defined in www\md5.js

md5("1234")

fxi commented Sep 17, 2015

@Martin9384 use your own password md5 hash.

Ex.

echo -n 1234 | md5sum

or in a javascript console with the function md5 defined in www\md5.js

md5("1234")
@Nisalz

This comment has been minimized.

Show comment Hide comment
@Nisalz

Nisalz Oct 13, 2015

Just wondering how would you code if there are multiple user accounts?
Thanks.

Nisalz commented Oct 13, 2015

Just wondering how would you code if there are multiple user accounts?
Thanks.

@1beb

This comment has been minimized.

Show comment Hide comment
@1beb

1beb Dec 4, 2015

Adding the following to the end of www/style.css fixes the presentation of the password box.

#passwd {
  display: block;
  width: 100%;
  height: 34px;
}

1beb commented Dec 4, 2015

Adding the following to the end of www/style.css fixes the presentation of the password box.

#passwd {
  display: block;
  width: 100%;
  height: 34px;
}
@eliezerspinto

This comment has been minimized.

Show comment Hide comment
@eliezerspinto

eliezerspinto Jan 29, 2016

It is a greats soluction.

It is a greats soluction.

@jbryer

This comment has been minimized.

Show comment Hide comment
@jbryer

jbryer Feb 2, 2016

This is fantastic. Is it possible to code a logout button? I have tried adding a logoutButton and processing it like below. However, this event is called but then immediately after the user is logged back in. My guess is that the values in the username and password text boxes are still there and being resubmitted, therefore undoing my logout. Any thoughts or help would greatly appreciated.

    observeEvent(input$logoutButton, {
        if(!is.null(input$logoutButton) & input$logoutButton == 1) {
            USER$Logged <- FALSE
            print(input$username)
        }
    })

Note: I added the print statement there and the value of input$username has the value from the first successful login attempt.

jbryer commented Feb 2, 2016

This is fantastic. Is it possible to code a logout button? I have tried adding a logoutButton and processing it like below. However, this event is called but then immediately after the user is logged back in. My guess is that the values in the username and password text boxes are still there and being resubmitted, therefore undoing my logout. Any thoughts or help would greatly appreciated.

    observeEvent(input$logoutButton, {
        if(!is.null(input$logoutButton) & input$logoutButton == 1) {
            USER$Logged <- FALSE
            print(input$username)
        }
    })

Note: I added the print statement there and the value of input$username has the value from the first successful login attempt.

@jbryer

This comment has been minimized.

Show comment Hide comment
@jbryer

jbryer Feb 2, 2016

Well, I figured out a solution. In order to force Shiny to re-render the username and password boxes, I need to change the id. My modified Login.R is below. I define a new uiLogout to create a logout button. The tl;dr is that I concatenate the current date and time to seconds to the id of the username and password fields. In order to know what the id is on both the ui and server side, I save it to the USER list. T

# See https://gist.github.com/withr/9001831 for more information

USER <- reactiveValues(Logged = Logged, 
                       Unique = format(Sys.time(), '%Y%m%d%H%M%S'),
                       Username = NA)

passwdInput <- function(inputId, label, value) {
    tagList(
        tags$label(label),
        tags$input(id=inputId, type="password", value=value)
    )
}

output$uiLogin <- renderUI({
    if(USER$Logged == FALSE) {
        wellPanel(
            div(textInput(paste0("username", USER$Unique), "Username: ", value='')),
            div(passwdInput(paste0("password", USER$Unique), "Password: ", value='')),
            br(), br(),
            actionButton("Login", "Login")
        )
    }
})

output$uiLogout <- renderUI({
    actionButton('logoutButton', 'Logout')
})

observeEvent(input$logoutButton, {
    if(!is.null(input$logoutButton) & input$logoutButton == 1) {
        USER$Logged <- FALSE
        USER$Username <- NA
        USER$Unique <- format(Sys.time(), '%Y%m%d%H%M%S')
    }
})

output$pass <- renderText({
    if(USER$Logged == FALSE) {
        if(!is.null(input$Login)) {
            if(input$Login > 0) {
                Username <- isolate(input[[paste0('username', USER$Unique)]])
                Password <- isolate(input[[paste0('password', USER$Unique)]])
                Id.username <- which(PASSWORD$Username == Username)
                if(length(Id.username) == 1 & 
                    Password == PASSWORD[Id.username,]$Password) {
                    USER$Logged <- TRUE
                    USER$Username <- Username
                } else  {
                    "Username or password failed!"
                }
            } 
        }
    }
})

jbryer commented Feb 2, 2016

Well, I figured out a solution. In order to force Shiny to re-render the username and password boxes, I need to change the id. My modified Login.R is below. I define a new uiLogout to create a logout button. The tl;dr is that I concatenate the current date and time to seconds to the id of the username and password fields. In order to know what the id is on both the ui and server side, I save it to the USER list. T

# See https://gist.github.com/withr/9001831 for more information

USER <- reactiveValues(Logged = Logged, 
                       Unique = format(Sys.time(), '%Y%m%d%H%M%S'),
                       Username = NA)

passwdInput <- function(inputId, label, value) {
    tagList(
        tags$label(label),
        tags$input(id=inputId, type="password", value=value)
    )
}

output$uiLogin <- renderUI({
    if(USER$Logged == FALSE) {
        wellPanel(
            div(textInput(paste0("username", USER$Unique), "Username: ", value='')),
            div(passwdInput(paste0("password", USER$Unique), "Password: ", value='')),
            br(), br(),
            actionButton("Login", "Login")
        )
    }
})

output$uiLogout <- renderUI({
    actionButton('logoutButton', 'Logout')
})

observeEvent(input$logoutButton, {
    if(!is.null(input$logoutButton) & input$logoutButton == 1) {
        USER$Logged <- FALSE
        USER$Username <- NA
        USER$Unique <- format(Sys.time(), '%Y%m%d%H%M%S')
    }
})

output$pass <- renderText({
    if(USER$Logged == FALSE) {
        if(!is.null(input$Login)) {
            if(input$Login > 0) {
                Username <- isolate(input[[paste0('username', USER$Unique)]])
                Password <- isolate(input[[paste0('password', USER$Unique)]])
                Id.username <- which(PASSWORD$Username == Username)
                if(length(Id.username) == 1 & 
                    Password == PASSWORD[Id.username,]$Password) {
                    USER$Logged <- TRUE
                    USER$Username <- Username
                } else  {
                    "Username or password failed!"
                }
            } 
        }
    }
})
@santoshmsk

This comment has been minimized.

Show comment Hide comment
@santoshmsk

santoshmsk Feb 4, 2016

Thanks for this great example.
But unable to get the login panel when plot is created in a fluidrow.
Any suggestion on this highly appreciated.

Thanks for this great example.
But unable to get the login panel when plot is created in a fluidrow.
Any suggestion on this highly appreciated.

@Varshul

This comment has been minimized.

Show comment Hide comment
@Varshul

Varshul Feb 9, 2016

Hey jbryer ,

Can you give a working example of how exactly you are doing this ?

Varshul commented Feb 9, 2016

Hey jbryer ,

Can you give a working example of how exactly you are doing this ?

@tanthiamhuat

This comment has been minimized.

Show comment Hide comment
@tanthiamhuat

tanthiamhuat Apr 23, 2016

with

passwd {

display: block;
width: 100%;
height: 34px;
}

the username is a round-corner rectangle, but the password is a 90deg corner rectangle. how do we change them to either one? either round-corner rectangle or 90deg rectangle for both username and password text input.
thanks.

with

passwd {

display: block;
width: 100%;
height: 34px;
}

the username is a round-corner rectangle, but the password is a 90deg corner rectangle. how do we change them to either one? either round-corner rectangle or 90deg rectangle for both username and password text input.
thanks.

@tanthiamhuat

This comment has been minimized.

Show comment Hide comment
@tanthiamhuat

tanthiamhuat Apr 23, 2016

jbryer commented on Feb 3, which I try, but there is no logout button, and it does not work.

jbryer commented on Feb 3, which I try, but there is no logout button, and it does not work.

@shivam7saxena

This comment has been minimized.

Show comment Hide comment
@shivam7saxena

shivam7saxena Apr 29, 2016

I'm not able to enter the username or password, the login window pops up but I'm not able to enter the username or password

I'm not able to enter the username or password, the login window pops up but I'm not able to enter the username or password

@pachiras

This comment has been minimized.

Show comment Hide comment
@pachiras

pachiras Jul 14, 2016

@Nisalz

Just rewrite the following line in server.R
PASSWORD <- data.frame(Brukernavn = c("withr","pachiras"), Passord = c("25d55ad283aa400af464c76d713c07ad","81b073de9370ea873f548e31b8adc081")

Just in case multiple users have a same password, you have to change the line in Login.R from
if (Id.username == Id.password) { USER$Logged <- TRUE }
to
if (Id.username %in% Id.password) { USER$Logged <- TRUE }

@Nisalz

Just rewrite the following line in server.R
PASSWORD <- data.frame(Brukernavn = c("withr","pachiras"), Passord = c("25d55ad283aa400af464c76d713c07ad","81b073de9370ea873f548e31b8adc081")

Just in case multiple users have a same password, you have to change the line in Login.R from
if (Id.username == Id.password) { USER$Logged <- TRUE }
to
if (Id.username %in% Id.password) { USER$Logged <- TRUE }

@kmezhoud

This comment has been minimized.

Show comment Hide comment
@kmezhoud

kmezhoud Sep 18, 2016

@pachiras
How Can I obtain 25d55ad283aa400af464c76d713c07ad from 12345678 using R?
Thanks

@pachiras
How Can I obtain 25d55ad283aa400af464c76d713c07ad from 12345678 using R?
Thanks

@tomliptrot

This comment has been minimized.

Show comment Hide comment
@tomliptrot

tomliptrot Nov 10, 2016

use the digest package

library(digest)
digest('12345678',  serialize = FALSE)

use the digest package

library(digest)
digest('12345678',  serialize = FALSE)
@Crisben

This comment has been minimized.

Show comment Hide comment
@Crisben

Crisben Dec 9, 2016

thanks for this example, it work's perfect in rstudio but when I put the code in my shinyserver folder to share it I have this error:
An error has occurred
The application failed to start.
The application exited during initialization.

I have other apps working, I tried with some suggestions from some blogs but it doesn't work.
Please help me

Crisben commented Dec 9, 2016

thanks for this example, it work's perfect in rstudio but when I put the code in my shinyserver folder to share it I have this error:
An error has occurred
The application failed to start.
The application exited during initialization.

I have other apps working, I tried with some suggestions from some blogs but it doesn't work.
Please help me

@ssrnaga

This comment has been minimized.

Show comment Hide comment
@ssrnaga

ssrnaga Jun 5, 2017

what is username and password for this password app

ssrnaga commented Jun 5, 2017

what is username and password for this password app

@JureLCrea

This comment has been minimized.

Show comment Hide comment
@JureLCrea

JureLCrea Jul 18, 2017

Can someone please explain the code in www\md5.js or maybe better just the idea behind it? What are the functions add32, cmn, ff, gg, hh, ii, ... doing?

Can someone please explain the code in www\md5.js or maybe better just the idea behind it? What are the functions add32, cmn, ff, gg, hh, ii, ... doing?

@Strongers

This comment has been minimized.

Show comment Hide comment
@Strongers

Strongers Sep 4, 2017

Very good to share content!

Very good to share content!

@m-haziq

This comment has been minimized.

Show comment Hide comment
@m-haziq

m-haziq Apr 9, 2018

Thanks for your effort, it saved alot of my time and gave me clear understanding as well ! (Y)

m-haziq commented Apr 9, 2018

Thanks for your effort, it saved alot of my time and gave me clear understanding as well ! (Y)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment