1parse_ssh_pem <- function(buf){
2  # extract the ssh2 pubkey text block
3  text <- rawToChar(buf)
4  regex <- "([-]+ BEGIN SSH2 PUBLIC KEY [-]+)(.*?)([-]+ END SSH2 PUBLIC KEY [-]+)"
5  m <- regexpr(regex, text)
6  if(m < 0)
7    stop("Failed to find SSH2 public key header/footer")
8
9  # strip off text headers and comments
10  text <- regmatches(text, m)
11  text <- sub("([-]+ BEGIN SSH2 PUBLIC KEY [-]+)[\\s]*", "", text)
12  text <- sub("([-]+ END SSH2 PUBLIC KEY [-]+)[\\s]*", "", text)
13  text <- sub("Comment(.*?)\\n", "", text)
14
15  # construct the actual key
16  ssh_pubkey_from_string(text)
17}
18
19validate_openssh <- function(str){
20  is.character(str) && grepl("^(ssh-dss|ssh-rsa|ssh-ed25519|ecdsa-sha2-nistp\\d+)\\s+", str[1])
21}
22
23parse_openssh <- function(buf){
24  text <- rawToChar(buf)
25  if(!validate_openssh(text))
26    stop("Unsupported ssh key id format: ", substring(text, 1, 15))
27
28  # Extract the base64 part
29  text <- sub("^\\S+\\s+", "", text)
30  text <- regmatches(text, regexpr("^\\S*", text))
31  ssh_pubkey_from_string(text)
32}
33
34# parse ssh binary format
35ssh_pubkey_from_string <- function(b64text){
36  ssh_build_pubkey(base64_decode(b64text))
37}
38
39ssh_parse_data <- function(data){
40  con <- rawConnection(data, open = "rb")
41  on.exit(close(con))
42  out <- list()
43  while(length(buf <- read_con_buf(con))){
44    out <- c(out, list(buf))
45  }
46  return(out)
47}
48
49ssh_build_pubkey <- function(keydata){
50  out <- ssh_parse_data(keydata)
51  header <- rawToChar(out[[1]])
52  switch(header,
53         "ssh-dss" = dsa_build(out),
54         "ssh-rsa" = rsa_build(out),
55         "ssh-ed25519" = ed25519_build(out),
56         "ecdsa-sha2-nistp256" = ecdsa_build(out),
57         "ecdsa-sha2-nistp384" = ecdsa_build(out),
58         "ecdsa-sha2-nistp521" = ecdsa_build(out),
59         stop("Unsupported keytype: ", header)
60  )
61}
62
63ssh_build_privkey <- function(keydata){
64  out <- ssh_parse_data(keydata)
65  header <- rawToChar(out[[1]])
66  switch(header,
67         "ssh-dss" = dsa_build_priv(out),
68         "ssh-rsa" = rsa_build_priv(out),
69         "ssh-ed25519" = ed25519_build_priv(out),
70         "ecdsa-sha2-nistp256" = ecdsa_build_priv(out),
71         "ecdsa-sha2-nistp384" = ecdsa_build_priv(out),
72         "ecdsa-sha2-nistp521" = ecdsa_build_priv(out),
73         stop("Unsupported keytype: ", header)
74  )
75}
76
77dsa_build_priv <- function(keydata){
78  p <- bignum(keydata[[2]])
79  q <- bignum(keydata[[3]])
80  g <- bignum(keydata[[4]])
81  y <- bignum(keydata[[5]])
82  x <- bignum(keydata[[6]])
83  structure(dsa_key_build(p, q, g, y, x), class = c("key", "dsa"))
84}
85
86rsa_build_priv <- function(keydata){
87  n <- bignum(keydata[[2]])
88  e <- bignum(keydata[[3]])
89  d <- bignum(keydata[[4]])
90  qi <- bignum(keydata[[5]])
91  p <- bignum(keydata[[6]])
92  q <- bignum(keydata[[7]])
93  structure(rsa_key_build(e, n, p, q, d, qi), class = c("key", "rsa"))
94}
95
96rsa_build <- function(keydata){
97  exp <- keydata[[2]]
98  mod <- keydata[[3]]
99  structure(rsa_pubkey_build(exp, mod), class = c("pubkey", "rsa"))
100}
101
102dsa_build <- function(keydata){
103  p <- keydata[[2]]
104  q <- keydata[[3]]
105  g <- keydata[[4]]
106  y <- keydata[[5]]
107  structure(dsa_pubkey_build(p, q, g, y), class = c("pubkey", "dsa"))
108}
109
110ed25519_build_priv <- function(keydata){
111  key <- read_raw_key_ed25519(utils::head(keydata[[3]], 32))
112  structure(key, class = c("key", "ed25519"))
113}
114
115ed25519_build <- function(keydata){
116  pubkey <- read_raw_pubkey_ed25519(keydata[[2]])
117  structure(pubkey, class = c("pubkey", "ed25519"))
118}
119
120ecdsa_build <- function(keydata){
121  curve_name <- rawToChar(keydata[[2]])
122  nist_name <- switch(curve_name,
123    "nistp256" = "P-256",
124    "nistp384" = "P-384",
125    "nistp521" = "P-521",
126    stop("Unsupported curve type: ", curve_name)
127  );
128  ec_point <- keydata[[3]]
129  if(ec_point[1] != 0x04)
130    stop("Invalid ecdsa format (not uncompressed?)")
131  ec_point <- ec_point[-1];
132  curve_size <- length(ec_point)/2
133  x <- utils::head(ec_point, curve_size)
134  y <- utils::tail(ec_point, curve_size)
135  structure(ecdsa_pubkey_build(x, y, nist_name), class = c("pubkey", "ecdsa"))
136}
137
138ecdsa_build_priv <- function(keydata){
139  curve_name <- rawToChar(keydata[[2]])
140  nist_name <- switch(curve_name,
141    "nistp256" = "P-256",
142    "nistp384" = "P-384",
143    "nistp521" = "P-521",
144    stop("Unsupported curve type: ", curve_name)
145  );
146  ec_point <- keydata[[3]]
147  if(ec_point[1] != 0x04)
148    stop("Invalid ecdsa format (not uncompressed?)")
149  ec_point <- ec_point[-1];
150  curve_size <- length(ec_point)/2
151  x <- utils::head(ec_point, curve_size)
152  y <- utils::tail(ec_point, curve_size)
153  secret <- keydata[[4]]
154  ecdsa_key_build(x, y, secret, nist_name)
155}
156
157# Assume we can just take the first key
158parse_openssh_key_pubkey <- function(input){
159  keydata <- parse_openssh_key_data(input)
160  ssh_build_pubkey(keydata$pubdata[[1]])
161}
162
163# Assume we can just take the first key
164parse_openssh_key_private <- function(input, password){
165  data <- parse_openssh_key_data(input)
166  ciphername <- data$ciphername
167  kdfname <- data$kdfname
168  input <- if(kdfname == "none") {
169    data$privdata
170  } else if(kdfname == "bcrypt") {
171    kdfopt <- parse_openssh_kdfoptions(data$kdfoptions)
172    if(is.function(password)){
173      password <- password("Please enter your private key passphrase")
174    } else if(!is.character(password)){
175      stop("Password is not a string or function")
176    }
177    cipher <- strsplit(ciphername, '-', fixed = TRUE)[[1]]
178    mode <- cipher[2]
179    keysize <- as.integer(sub("aes-?", "", cipher[1])) / 8
180    ivsize <- ifelse(identical(mode, "gcm"), 12, 16)
181    kdfsize <- as.integer(keysize + ivsize)
182    key_iv <- bcrypt_pbkdf(password, salt = kdfopt$salt, rounds = kdfopt$rounds, size = kdfsize)
183    aes_decrypt(data$privdata, key = key_iv[seq_len(keysize)], iv = key_iv[-seq_len(keysize)], mode)
184  } else {
185    stop(sprintf("Unsupported key encryption: %s (%s)", kdfname, ciphername))
186  }
187  if(!identical(input[1:4], input[5:8]))
188    stop("Check failed, invalid passphrase?")
189  ssh_build_privkey(input[-seq_len(8)])
190}
191
192parse_openssh_kdfoptions <- function(input){
193  con <- rawConnection(input, open = "rb")
194  on.exit(close(con))
195  list(
196    salt = read_con_buf(con),
197    rounds = readBin(con, 1L, endian = 'big')
198  )
199}
200
201parse_openssh_key_data <- function(input){
202  pemdata <- parse_pem(input)
203  data <- pemdata[[1]]$data
204  con <- rawConnection(data, open = "rb")
205  on.exit(close(con))
206  header <- readBin(con, "")
207  ciphername <- read_con_string(con)
208  kdfname <- read_con_string(con)
209  kdfoptions <- read_con_buf(con)
210  count <- readBin(con, 1L, endian = "big")
211  pubdata <- lapply(seq_len(count), function(i){read_con_buf(con)})
212  privdata <- read_con_buf(con)
213  stopifnot(is.null(read_con_buf(con)))
214  list (
215    header = header,
216    ciphername = ciphername,
217    kdfname = kdfname,
218    kdfoptions = kdfoptions,
219    count = count,
220    pubdata = pubdata,
221    privdata = privdata
222  )
223}
224
225read_con_buf <- function(con){
226  size <- readBin(con, 1L, endian = "big")
227  if(!length(size))
228    return(NULL)
229  if(size == 0)
230    return(raw())
231  buf <- readBin(con, raw(), size)
232  # see padding_start() below for 16909060L
233  # padding spec: https://cvsweb.openbsd.org/src/usr.bin/ssh/PROTOCOL.key?annotate=HEAD
234  if(length(buf) < size){
235    if(size == 16909060L && identical(buf, as.raw(seq_len(length(buf)) + 4))){
236      return(NULL)
237    } else {
238      stop("Trailing trash found in buffer")
239    }
240  }
241  return(buf)
242}
243
244# Proof that 16909060L equals padding
245padding_start <- function(){
246  data <- as.raw(1:4)
247  con <- rawConnection(data, open = "rb")
248  on.exit(close(con))
249  readBin(con, integer(), endian = 'big')
250}
251
252read_con_string <- function(con){
253  rawToChar(read_con_buf(con))
254}
255