Last active
December 14, 2015 00:59
-
-
Save twittoru/5003283 to your computer and use it in GitHub Desktop.
SHA-1 in pure R / attendant unsigned int32 and bitwise operation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| library(methods) | |
| # bitwise operation | |
| Bit32 <- setRefClass("bit32", | |
| methods = list( | |
| rotate = function(a,s) { | |
| ior(shift(a,s),shift(a,-(32-s))) | |
| }, | |
| shift = function(a,shift) { | |
| if(class(a) != "uint32") a <- UInt32$new(a) | |
| if(shift == 0) return(a) | |
| signshift <- sign(shift) | |
| shift <- abs(shift) | |
| se <- ifelse(signshift > c(0,0),c(0,shift),c(shift,0)) | |
| bits <- c(rep(F,se[2]),a$bits[(1+se[1]):(32-se[2])],rep(F,se[1])) | |
| byte <- packBits(bits) | |
| num <- sum(as.integer(byte) * 2^(c(0,8,16,24))) | |
| return(UInt32$new(num,obyte=byte,obits=bits)) | |
| }, | |
| not = function(a) { | |
| if(class(a) != "uint32") a <- UInt32$new(a) | |
| bits <- (!as.logical(a$bits)) | |
| #byte <- packBits(bits) | |
| byte <- !a$byte | |
| num <- sum(as.integer(byte) * 2^(c(0,8,16,24))) | |
| return(UInt32$new(num,byte,bits)) | |
| }, | |
| xor = function(a,b) { | |
| if(class(a) != "uint32") a <- UInt32$new(a) | |
| if(class(b) != "uint32") b <- UInt32$new(b) | |
| bits <- base::xor(a$bits , b$bits) | |
| #byte <- packBits(bits) | |
| byte <- base::xor(a$byte , b$byte) | |
| num <- sum(as.integer(byte) * 2^(c(0,8,16,24))) | |
| return(UInt32$new(num,byte,bits)) | |
| }, | |
| ior = function(a,b) { | |
| if(class(a) != "uint32") a <- UInt32$new(a) | |
| if(class(b) != "uint32") b <- UInt32$new(b) | |
| bits <- a$bits | b$bits | |
| #byte <- packBits(bits) | |
| byte <- a$byte | b$byte | |
| num <- sum(as.integer(byte) * 2^(c(0,8,16,24))) | |
| return(UInt32$new(num,byte,bits)) | |
| }, | |
| and = function(a,b) { | |
| if(class(a) != "uint32") a <- UInt32$new(a) | |
| if(class(b) != "uint32") b <- UInt32$new(b) | |
| bits <- a$bits & b$bits | |
| #byte <- packBits(bits) | |
| byte <- a$byte & b$byte | |
| num <- sum(as.integer(byte) * 2^(c(0,8,16,24))) | |
| return(UInt32$new(num,byte,bits)) | |
| } | |
| ) | |
| ) | |
| # unsigned int32 | |
| # byte : 4-length raw | |
| # bits : 32-length bit (bit is 0/1 raw) | |
| # num : fractional part of double (as 52bit integer) | |
| UInt32 <- setRefClass("uint32", | |
| fields = list( | |
| byte = "raw", | |
| bits = "logical", | |
| num = "numeric" | |
| ), | |
| methods = list( | |
| initialize = function(num=0,obyte=NA,obits=NA) { | |
| if((!is.na(obyte) && !is.na(obits))){ | |
| bits <<- obits | |
| byte <<- obyte | |
| if(num > 0){ | |
| num <<- num | |
| } else { | |
| num <<- sum(as.integer(byte) * 2^(c(0,8,16,24))) | |
| } | |
| } else if(num < .Machine$integer.max) { | |
| bits <<- as.logical(intToBits(num)) | |
| byte <<- packBits(bits) | |
| num <<- num | |
| } else if(num < (.Machine$integer.max+1)*2) { | |
| lsword <- num %% 2^16 | |
| msword <- num %/% 2^16 | |
| bits[32:17] <<- as.logical(intToBits(msword)[16:1]) | |
| bits[16:1] <<- as.logical(intToBits(lsword)[16:1]) | |
| byte <<- packBits(bits) | |
| num <<- num | |
| } else { | |
| stop(sprintf("%g is out of range",num)) | |
| } | |
| return(.self) | |
| } | |
| ) | |
| ) | |
| # Add(a,b) := a + b (mod UINT32_MAX+1) | |
| `+.uint32` <- function(a,b) { | |
| added <- (a$num + b$num) %% 2^32 | |
| UInt32$new(added) | |
| } | |
| # bitwise operator | |
| bit32 <- Bit32$new() | |
| # sha-1 function | |
| f00 <- function(B,C,D) { | |
| return(bit32$ior(bit32$and(B , C) , bit32$and(bit32$not(B), D))) | |
| } | |
| f20 <- function(B,C,D) { | |
| return(Reduce(bit32$xor,c(B,C,D))) | |
| } | |
| f40 <- function(B,C,D) { | |
| return(Reduce(bit32$ior,c(bit32$and(B,C),bit32$and(B,D),bit32$and(C,D)))) | |
| } | |
| f <- c(f00,f20,f40,f20) | |
| # sha-1 constant | |
| K <- sapply(c( | |
| 0x5A827999, | |
| 0x6ED9EBA1, | |
| 0x8F1BBCDC, | |
| 0xCA62C1D6 | |
| ),UInt32$new) | |
| # sha-1 class | |
| SHA1 <- setRefClass("sha1", | |
| fields = list( | |
| H0 = "uint32" | |
| ,H1 = "uint32" | |
| ,H2 = "uint32" | |
| ,H3 = "uint32" | |
| ,H4 = "uint32" | |
| ,message = "raw" | |
| ), | |
| methods = list( | |
| initialize = function() { | |
| .self$reset() | |
| }, | |
| reset = function() { | |
| message <<- as.raw(c()) | |
| H0 <<- UInt32$new(0x67452301) | |
| H1 <<- UInt32$new(0xEFCDAB89) | |
| H2 <<- UInt32$new(0x98BADCFE) | |
| H3 <<- UInt32$new(0x10325476) | |
| H4 <<- UInt32$new(0xC3D2E1F0) | |
| }, | |
| digest = function() { | |
| masterblock <- expand(message) | |
| for(idx in 1:(length(masterblock)%/%64)) { | |
| A <- H0 | |
| B <- H1 | |
| C <- H2 | |
| D <- H3 | |
| E <- H4 | |
| block <- masterblock[(1:64)+(64*(idx-1))] | |
| calcBlock <- function(i,n) { | |
| intToBits(block[i*4+n])[1:8] | |
| } | |
| W <- list() | |
| length(W) <- 80 | |
| for(i in 0:17) { | |
| bits <- as.logical(c(calcBlock(i,4),calcBlock(i,3),calcBlock(i,2),calcBlock(i,1))) | |
| byte <- packBits(bits) | |
| W[[i+1]] <- UInt32$new(obits=bits,obyte=byte) | |
| } | |
| for(i in 17:80) { | |
| W[i] <- bit32$rotate(Reduce(bit32$xor,c(W[[i-3]],W[[i-8]],W[[i-14]],W[[i-16]])),1) | |
| } | |
| for(i in 0:3){ | |
| for(j in 1:20) { | |
| temp <- Reduce(`+`,c(bit32$rotate(A,5) , f[[i+1]](B,C,D) , E , W[[i*20+j]] , K[[i+1]])) | |
| E <- D | |
| D <- C | |
| C <- bit32$rotate(B,30) | |
| B <- A | |
| A <- temp | |
| } | |
| } | |
| H4 <<- H4 + E | |
| H3 <<- H3 + D | |
| H2 <<- H2 + C | |
| H1 <<- H1 + B | |
| H0 <<- H0 + A | |
| } | |
| return(rev(c( | |
| H4$byte, | |
| H3$byte, | |
| H2$byte, | |
| H1$byte, | |
| H0$byte | |
| ))) | |
| }, | |
| update = function(msg) { | |
| if(is.character(msg)) msg <- charToRaw(msg) | |
| message <<- c(message,msg) | |
| }, | |
| expand = function(msg) { | |
| len <- length(msg) | |
| bitLength <- c(rep(as.raw(0x00),4),rev(UInt32$new(len*8)$byte)) | |
| needZero <- (64 - 8) - ( len + 1 ) %% 64 | |
| if(needZero < 0) { | |
| c(msg,as.raw(0x80),rep(as.raw(0x00),needZero+64),bitLength) | |
| } else { | |
| c(msg,as.raw(0x80),rep(as.raw(0x00),needZero),bitLength) | |
| } | |
| } | |
| ) | |
| ) | |
| # test (example) | |
| library(testthat) | |
| test_that("sha1",{ | |
| sha1 <- SHA1$new() | |
| sha1$reset() | |
| sha1$update("abcde") | |
| expect_equal( | |
| (paste(sha1$digest(),collapse="")), | |
| "03de6c570bfe24bfc328ccd7ca46b76eadaf4334" | |
| ) | |
| sha1$reset() | |
| sha1$update(rep(charToRaw("a"),120)) | |
| expect_equal( | |
| paste(sha1$digest(),collapse=""), | |
| "f34c1488385346a55709ba056ddd08280dd4c6d6" | |
| ) | |
| }) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment