Skip to content

Instantly share code, notes, and snippets.

@withr
Last active August 26, 2023 02:31
Show Gist options
  • Star 76 You must be signed in to star a gist
  • Fork 62 You must be signed in to fork a gist
  • Save withr/9001831 to your computer and use it in GitHub Desktop.
Save withr/9001831 to your computer and use it in GitHub Desktop.
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;
}
@Nisalz
Copy link

Nisalz commented Oct 13, 2015

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

@1beb
Copy link

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
Copy link

It is a greats soluction.

@jbryer
Copy link

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
Copy link

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
Copy link

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
Copy link

Varshul commented Feb 9, 2016

Hey jbryer ,

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

@tanthiamhuat
Copy link

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
Copy link

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

@shivam7saxena
Copy link

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
Copy link

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

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

@tomliptrot
Copy link

use the digest package

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

@Crisben
Copy link

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
Copy link

ssrnaga commented Jun 5, 2017

what is username and password for this password app

@JureLCrea
Copy link

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
Copy link

Very good to share content!

@m-haziq
Copy link

m-haziq commented Apr 9, 2018

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

@imanojkumar
Copy link

user name : withr
password: 12345678

@hostrings
Copy link

We can use MD5 hash generator:

http://passwordsgenerators.net/md5-hash-generator

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