putty.vbs with 1password support

' This script is primarily maintained on Github: https://gist.github.com/kmpoppe/52ff04186f52e20078f66da7e4d9ff6b
'
' The aim of this script is to execute putty with parameters like ssh://login@host directly using an URL in a browser
'
' Update 2019-02-02, Kai Michael Poppe (twitter @kmpoppe):
' This script now also accepts item and vault data from 1password so that you can log in to putty without having
' username and password in the URL but getting it from your 1password vault. The script now makes use of a Json lib
' by "demon" (http://demon.tw/my-work/vbs-json.html)
'
' Installation:
'   - Launch putty.reg to associate ssh:// and telnet:// to this script
'   - Edit the putty path in parameter below like puttyPath = "C:\Program Files (x86)\putty.exe"
'   - Save this .vbs on your PC like c:\putty.vbs (or change the path in putty.reg)
' If you want to use the script with 1password:
'   - Get 1password CLI-tool from https://app-updates.agilebits.com/product_history/CLI
'   - Read how to get a signin session (variable opSession below): https://support.1password.com/command-line/
' Uninstallation:
'   - Run unputty.reg
' Version 2014-04-23'
' Script Created by Sebastien Biffi
'
' Source Original: https://gist.github.com/sbiffi

puttyPath = "C:\Program Files\putty\putty.exe"
opPath = "<PATH TO OP.EXE>\op.exe"
opSession = "<SESSION ID FROM OP SIGNIN>"

On Error Resume Next
' initialisation of variables
logResult = "" ' Used for logging purpose during debug or in case of error. Log is a msgBox
logIcon = 0 ' Icon of the MsgBox. By default: none
logTitle = "" ' Title of the MsgBox. By default: none
Set objShell = CreateObject("WScript.Shell")

Set re = New RegExp
' The pattern that matches the URL. Used to check the URL format provided and find fields in it.
re.Pattern = "^([^:]+)://(([^:]+)(:(.*))?@)?(([^/@:]+)(:([0-9]+))?)/?(\?onepasswdfill=(.*)\&onepasswdvault=(.*))?$"

' Check if only 1 parameter is passed to the script, else throw an error
if Wscript.Arguments.Count = 1 then
    url = Wscript.Arguments(0)
else
    exitWithError("Please pass only 1 parameter to this script like:" & vbCrLf & "   - ssh://login:password@host:port " & vbCrLf & "   - telnet://login@host:port" & vbCrLf & "login, password & port are optional")
end if

' Check if the URL is valid, else throw an error
If re.Test(url) Then
    log("URL is valid: " & url)
Else
    exitWithError(url & " is NOT a valid URL" & vbCrLf & "Please pass only 1 parameter to this script like:" & vbCrLf & "   - ssh://login:password@host:port " & vbCrLf & "   - telnet://login@host:port" & vbCrLf & "login, password & port are optional")
End If

' Find the putty parameters in the URL
Set Matches = re.Execute(url)
protocol = Matches.Item(0).Submatches(0)
login = Matches.Item(0).Submatches(2)
pwd = Matches.Item(0).Submatches(4)
host = Matches.Item(0).Submatches(6)
port = Matches.Item(0).Submatches(8)

' See if 1Password url parts are provided and replace user/password from the item
opwditem = Matches.Item(0).Submatches(10)
opwdvault = Matches.Item(0).Submatches(11)

If opwditem <> "" And opwdvault <> "" Then
    Dim opExecStatement, strTempFileName, opJson
    Set fso = CreateObject("Scripting.FileSystemObject")

    strTempFileName = fso.GetSpecialFolder(2) & "\" & fso.GetTempName
    opExecStatement = opPath & " get item " & opwditem & " --vault=" & opwdvault & " --session=" & opSession & " > " & strTempFileName
    Set returnValue = objShell.Run("cmd /c " & opExecStatement, 0, true)

    Set jsonFile = fso.OpenTextFile(strTempFileName, 1)
    opJson = jsonFile.ReadAll
    jsonFile.Close
    fso.DeleteFile strTempFileName

    Dim json, o, i
    Set json = New VbsJson
    Set o = json.Decode(opJson)
    For Each i In o("details")("fields")
        If i("designation") = "username" Then login = i("value")
        If i("designation") = "password" Then pwd = i("value")
    Next
End If

log("  host: " & host)
log("  protocol: " & protocol)
log("  port: " & port)
log("  login: " & login)
log("  pwd: " & pwd)

if protocol = "ssh" then
    paramProtocol = " -ssh"
elseif protocol = "telnet" then
    paramProtocol = " -telnet"
else
    exitWithError("Protocol: " & protocol & " is not a valid protocol (ssh or telnet).")
end if
if host <> "" then
    paramHost = " " & host
else
    exitWithError("Host cannot bu null.")
end if
if login <> "" then
    paramLogin = " -l " & login
end if
if (pwd <> "") and (protocol <> "telnet") then
    paramPwd = " -pw " & pwd
end if
if port <> "" then
    paramPort = " -P " & port
end if

' build the putty command like:
' putty.exe -ssh host -l login -pw password -P port
' putty.exe -telnet host -l login -P port
puttyCommand = chr(34) & puttyPath & chr(34) & paramProtocol & paramHost & paramLogin & paramPwd & paramPort
log (puttyCommand)

' For debugging purpose, uncomment following line:
'outputLog()

' Execute putty
objShell.Run puttyCommand,1,False

' ****************
'   Error Output
' ****************
' Outputs a msgBox including the log and the error message
function exitWithError(str)
    log(str)
  logIcon = vbCritical
    logTitle = "Error"
    outputLog()
    wscript.Quit
end function

' ***********
'   Logging
' ***********
' Adds a message to the log String
function log(str)
    if logResult = "" then
        logResult = str
    else
        logResult = logResult & vbCrLf & str
    end if
end function
' Outputs a msgBox including the log String
function outputLog()
    if logResult <> "" then
        MsgBox logResult, logIcon, logTitle
    end if
end function

''' This class is imported here unchanged from the website mentioned below

Class VbsJson
    'Author: Demon
    'Date: 2012/5/3
    'Website: http://demon.tw
    Private Whitespace, NumberRegex, StringChunk
    Private b, f, r, n, t

    Private Sub Class_Initialize
        Whitespace = " " & vbTab & vbCr & vbLf
        b = ChrW(8)
        f = vbFormFeed
        r = vbCr
        n = vbLf
        t = vbTab

        Set NumberRegex = New RegExp
        NumberRegex.Pattern = "(-?(?:0|[1-9]\d*))(\.\d+)?([eE][-+]?\d+)?"
        NumberRegex.Global = False
        NumberRegex.MultiLine = True
        NumberRegex.IgnoreCase = True

        Set StringChunk = New RegExp
        StringChunk.Pattern = "([\s\S]*?)([""\\\x00-\x1f])"
        StringChunk.Global = False
        StringChunk.MultiLine = True
        StringChunk.IgnoreCase = True
    End Sub

    'Return a JSON string representation of a VBScript data structure
    'Supports the following objects and types
    '+-------------------+---------------+
    '| VBScript          | JSON          |
    '+===================+===============+
    '| Dictionary        | object        |
    '+-------------------+---------------+
    '| Array             | array         |
    '+-------------------+---------------+
    '| String            | string        |
    '+-------------------+---------------+
    '| Number            | number        |
    '+-------------------+---------------+
    '| True              | true          |
    '+-------------------+---------------+
    '| False             | false         |
    '+-------------------+---------------+
    '| Null              | null          |
    '+-------------------+---------------+
    Public Function Encode(ByRef obj)
        Dim buf, i, c, g
        Set buf = CreateObject("Scripting.Dictionary")
        Select Case VarType(obj)
            Case vbNull
                buf.Add buf.Count, "null"
            Case vbBoolean
                If obj Then
                    buf.Add buf.Count, "true"
                Else
                    buf.Add buf.Count, "false"
                End If
            Case vbInteger, vbLong, vbSingle, vbDouble
                buf.Add buf.Count, obj
            Case vbString
                buf.Add buf.Count, """"
                For i = 1 To Len(obj)
                    c = Mid(obj, i, 1)
                    Select Case c
                        Case """" buf.Add buf.Count, "\"""
                        Case "\"  buf.Add buf.Count, "\\"
                        Case "/"  buf.Add buf.Count, "/"
                        Case b    buf.Add buf.Count, "\b"
                        Case f    buf.Add buf.Count, "\f"
                        Case r    buf.Add buf.Count, "\r"
                        Case n    buf.Add buf.Count, "\n"
                        Case t    buf.Add buf.Count, "\t"
                        Case Else
                            If AscW(c) >= 0 And AscW(c) <= 31 Then
                                c = Right("0" & Hex(AscW(c)), 2)
                                buf.Add buf.Count, "\u00" & c
                            Else
                                buf.Add buf.Count, c
                            End If
                    End Select
                Next
                buf.Add buf.Count, """"
            Case vbArray + vbVariant
                g = True
                buf.Add buf.Count, "["
                For Each i In obj
                    If g Then g = False Else buf.Add buf.Count, ","
                    buf.Add buf.Count, Encode(i)
                Next
                buf.Add buf.Count, "]"
            Case vbObject
                If TypeName(obj) = "Dictionary" Then
                    g = True
                    buf.Add buf.Count, "{"
                    For Each i In obj
                        If g Then g = False Else buf.Add buf.Count, ","
                        buf.Add buf.Count, """" & i & """" & ":" & Encode(obj(i))
                    Next
                    buf.Add buf.Count, "}"
                Else
                    Err.Raise 8732,,"None dictionary object"
                End If
            Case Else
                buf.Add buf.Count, """" & CStr(obj) & """"
        End Select
        Encode = Join(buf.Items, "")
    End Function

    'Return the VBScript representation of ``str(``
    'Performs the following translations in decoding
    '+---------------+-------------------+
    '| JSON          | VBScript          |
    '+===============+===================+
    '| object        | Dictionary        |
    '+---------------+-------------------+
    '| array         | Array             |
    '+---------------+-------------------+
    '| string        | String            |
    '+---------------+-------------------+
    '| number        | Double            |
    '+---------------+-------------------+
    '| true          | True              |
    '+---------------+-------------------+
    '| false         | False             |
    '+---------------+-------------------+
    '| null          | Null              |
    '+---------------+-------------------+
    Public Function Decode(ByRef str)
        Dim idx
        idx = SkipWhitespace(str, 1)

        If Mid(str, idx, 1) = "{" Then
            Set Decode = ScanOnce(str, 1)
        Else
            Decode = ScanOnce(str, 1)
        End If
    End Function

    Private Function ScanOnce(ByRef str, ByRef idx)
        Dim c, ms

        idx = SkipWhitespace(str, idx)
        c = Mid(str, idx, 1)

        If c = "{" Then
            idx = idx + 1
            Set ScanOnce = ParseObject(str, idx)
            Exit Function
        ElseIf c = "[" Then
            idx = idx + 1
            ScanOnce = ParseArray(str, idx)
            Exit Function
        ElseIf c = """" Then
            idx = idx + 1
            ScanOnce = ParseString(str, idx)
            Exit Function
        ElseIf c = "n" And StrComp("null", Mid(str, idx, 4)) = 0 Then
            idx = idx + 4
            ScanOnce = Null
            Exit Function
        ElseIf c = "t" And StrComp("true", Mid(str, idx, 4)) = 0 Then
            idx = idx + 4
            ScanOnce = True
            Exit Function
        ElseIf c = "f" And StrComp("false", Mid(str, idx, 5)) = 0 Then
            idx = idx + 5
            ScanOnce = False
            Exit Function
        End If

        Set ms = NumberRegex.Execute(Mid(str, idx))
        If ms.Count = 1 Then
            idx = idx + ms(0).Length
            ScanOnce = CDbl(ms(0))
            Exit Function
        End If

        Err.Raise 8732,,"No JSON object could be ScanOnced"
    End Function

    Private Function ParseObject(ByRef str, ByRef idx)
        Dim c, key, value
        Set ParseObject = CreateObject("Scripting.Dictionary")
        idx = SkipWhitespace(str, idx)
        c = Mid(str, idx, 1)

        If c = "}" Then
            Exit Function
        ElseIf c <> """" Then
            Err.Raise 8732,,"Expecting property name"
        End If

        idx = idx + 1

        Do
            key = ParseString(str, idx)

            idx = SkipWhitespace(str, idx)
            If Mid(str, idx, 1) <> ":" Then
                Err.Raise 8732,,"Expecting : delimiter"
            End If

            idx = SkipWhitespace(str, idx + 1)
            If Mid(str, idx, 1) = "{" Then
                Set value = ScanOnce(str, idx)
            Else
                value = ScanOnce(str, idx)
            End If
            ParseObject.Add key, value

            idx = SkipWhitespace(str, idx)
            c = Mid(str, idx, 1)
            If c = "}" Then
                Exit Do
            ElseIf c <> "," Then
                Err.Raise 8732,,"Expecting , delimiter"
            End If

            idx = SkipWhitespace(str, idx + 1)
            c = Mid(str, idx, 1)
            If c <> """" Then
                Err.Raise 8732,,"Expecting property name"
            End If

            idx = idx + 1
        Loop

        idx = idx + 1
    End Function

    Private Function ParseArray(ByRef str, ByRef idx)
        Dim c, values, value
        Set values = CreateObject("Scripting.Dictionary")
        idx = SkipWhitespace(str, idx)
        c = Mid(str, idx, 1)

        If c = "]" Then
            ParseArray = values.Items
            Exit Function
        End If

        Do
            idx = SkipWhitespace(str, idx)
            If Mid(str, idx, 1) = "{" Then
                Set value = ScanOnce(str, idx)
            Else
                value = ScanOnce(str, idx)
            End If
            values.Add values.Count, value

            idx = SkipWhitespace(str, idx)
            c = Mid(str, idx, 1)
            If c = "]" Then
                Exit Do
            ElseIf c <> "," Then
                Err.Raise 8732,,"Expecting , delimiter"
            End If

            idx = idx + 1
        Loop

        idx = idx + 1
        ParseArray = values.Items
    End Function

    Private Function ParseString(ByRef str, ByRef idx)
        Dim chunks, content, terminator, ms, esc, char
        Set chunks = CreateObject("Scripting.Dictionary")

        Do
            Set ms = StringChunk.Execute(Mid(str, idx))
            If ms.Count = 0 Then
                Err.Raise 8732,,"Unterminated string starting"
            End If

            content = ms(0).Submatches(0)
            terminator = ms(0).Submatches(1)
            If Len(content) > 0 Then
                chunks.Add chunks.Count, content
            End If

            idx = idx + ms(0).Length

            If terminator = """" Then
                Exit Do
            ElseIf terminator <> "\" Then
                Err.Raise 8732,,"Invalid control character"
            End If

            esc = Mid(str, idx, 1)

            If esc <> "u" Then
                Select Case esc
                    Case """" char = """"
                    Case "\"  char = "\"
                    Case "/"  char = "/"
                    Case "b"  char = b
                    Case "f"  char = f
                    Case "n"  char = n
                    Case "r"  char = r
                    Case "t"  char = t
                    Case Else Err.Raise 8732,,"Invalid escape"
                End Select
                idx = idx + 1
            Else
                char = ChrW("&H" & Mid(str, idx + 1, 4))
                idx = idx + 5
            End If

            chunks.Add chunks.Count, char
        Loop

        ParseString = Join(chunks.Items, "")
    End Function

    Private Function SkipWhitespace(ByRef str, ByVal idx)
        Do While idx <= Len(str) And _
            InStr(Whitespace, Mid(str, idx, 1)) > 0
            idx = idx + 1
        Loop
        SkipWhitespace = idx
    End Function

End Class