open FSharp.Data
open FSharp.Data.JsonExtensions
open System.Xml
open System.Net
open System.Web
open System.IO
open System.Text
(*
# WHAT IS THIS?
An F# script to import Fogbugz tickets into Phabricator.
Feel free to port the logic if you can't get F# running on your platform.
## Notes:
- No warranty.
- You will want to change constants and debug first and THEN have it actually import.
- You will need to put this in a Program.fs in a project with FSharp.Data added,
and reference the above assemblies.
- There are a lot of constants. You should probably look at what they do before you run this.
This script does a few environment-tuned and project-specific things:
- Things in a milestone "Future" will get added to the #Future project in Phabricator
- It assumes usernames are LDAP - should work fine if not, but if you have trouble,
change DOMAIN because I am lazy
- I arbitrarily truncate the import at 30 comments, configurable.
We have error reporting tickets that have hundredddds.
This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.
In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to <http://unlicense.org/>
*)
// Debugging is fun!
let DEBUG = false
let DEBUG_MULTIPART = false
// Fogbugz settings
let FOGBUGZ_URL = "http://fogbugz/api.asp"
let DOMAIN = "WISLEG"
// Phabricator settings
let PHABRICATOR_URL = "https://phab.wisleg.root.local/"
let PHABRICATOR_USER = "Bob"
let CONDUIT_TOKEN = "api-zs6inn5omfwoppfn5hqwyhsalqv7"
// Useful for testing small numbers of tickets before the real import
let MAX_TICKETS = 2000
// Truncates the imported comments at a certain sane limit
let MAX_COMMENTS = 30
let FOGBUGZ_CASE_FIELDS = "ixBug,sEvent,sTitle,sLatestTextSummary,sProject,sArea,sTags,ixPriority,ixPersonAssignedTo,sFixFor,sCategory"
let stringToXml s =
let doc = new XmlDocument()
doc.LoadXml s
doc
let xfind (elem:System.Xml.XmlNode) x =
let inner = elem.Item(x,"")
if inner = null then "" else
inner.InnerText
let fetchMultipart (url:string) args =
let encoding = new ASCIIEncoding()
let utf8encoding = new UTF8Encoding()
let http = HttpWebRequest.Create(url) :?> HttpWebRequest
http.Method <- "POST";
http.AllowWriteStreamBuffering <- true
let boundaryString = "----------------DEADBEEFHOORAY"
let boundary = "--" + boundaryString
http.ContentType <- "multipart/form-data; boundary=" + boundaryString
let writeAscii (s:string) =
encoding.GetBytes s
let writeUTF8 (s:string) =
utf8encoding.GetBytes s
let cr = System.Environment.NewLine
let output =
args
|> List.map (fun (k,v) ->
[
boundary + cr
|> writeAscii
"Content-Type: text/plain; charset=\"utf-8\"" + cr
|> writeAscii
"Content-Disposition: form-data; name=\"" + k + "\"" + cr + cr
|> writeAscii
writeUTF8 v
writeAscii cr
]
)
|> List.concat
let finalOutput =
output @ [writeAscii (boundary + "--")]
let length = finalOutput |> List.fold (fun total b -> total + b.Length) 0
if DEBUG_MULTIPART then
printfn "Got length %i" length
printfn "Sending args %A" args
printfn "Sending output:"
(finalOutput |> List.iter (fun b -> printf "%s" <| encoding.GetString(b)) )
http.ContentLength <- int64 length
let stream = http.GetRequestStream()
for x in finalOutput do
stream.Write(x, 0, x.Length)
stream.Close()
let response = http.GetResponse().GetResponseStream()
let reader = new StreamReader(response)
let returnString = reader.ReadToEnd()
reader.Close()
returnString
let fogbugzFetch args =
fetchMultipart FOGBUGZ_URL args
let fogbugzXml args = fogbugzFetch args |> stringToXml
let addToken token args = args @ ["token", token]
type Fogbugz = {
Token: string
Users: (string * string) list
Projects: (string * string) list
} with
static member Connect(username, password) =
let doc = fogbugzXml [ ("email", username); ("password", password); ("cmd", "logon") ]
let tokens = doc.SelectNodes("//token")
if (tokens.Count < 1) then failwith (sprintf "Unexpected result from FogBugz: %s" doc.InnerXml)
let token = tokens.[0].InnerText
let fetch = addToken token >> fogbugzXml
let doc = fetch [ ("cmd", "listPeople") ]
let users =
[ for p in doc.SelectNodes("//person") do
let find = xfind p
yield ( find "ixPerson",
(find "sLDAPUid").Replace(DOMAIN + "\\","") )
]
let doc = fetch [ ("cmd", "listProjects") ]
let projects =
[ for p in doc.SelectNodes("//project") do
let find = xfind p
yield ( find "ixProject",
find "sProject" )
]
{
Token = token
Users = users
Projects = projects
}
member self.Fetch =
addToken self.Token >> fogbugzXml
member self.Search(q, cols, max) =
let cols = defaultArg cols "ixBug,sEvent,sTitle,ixProject"
self.Fetch [
("q", q)
("cols", cols)
("max", string max)
("cmd", "search")
]
member self.LookupUser ixPerson =
self.Users
|> List.tryPick (fun (i,n) -> if i = ixPerson then Some n else None)
type PhabUser = JsonProvider<"""
[ {
"phid": "PHID-USER-3fstcq463si2mqwbhg3d",
"userName": "JDoe",
"realName": "John Doe",
"image": "https:\/\/phab.wisleg.root.local\/res\/phabricator\/3eb28cd9\/rsrc\/image\/avatar.png",
"uri": "https:\/\/phab.wisleg.root.local\/p\/JDoe\/",
"roles": [
"verified",
"approved",
"activated"
]
} ]
""">
type PhabProject = JsonProvider<"""
{
"id": "1",
"phid": "PHID-PROJ-7k3ihejmysfbrinsjssu",
"name": "Name",
"profileImagePHID": "PHID-FILE-wpx363l4xiu76te7z2jq",
"icon": "cloud",
"color": "red",
"members": [
"PHID-USER-yrmohaxcwbumgouvdyio"
],
"slugs": [
"projectname"
],
"dateCreated": "1432234693",
"dateModified": "1432310731"
}
""">
let fetch (url:string) (args: (string * string) list) =
let http = HttpWebRequest.Create(url) :?> HttpWebRequest
http.Method <- "POST";
http.AllowWriteStreamBuffering <- true
http.ContentType <- "application/json"
let concatArgs =
args
|> List.map ( fun (k,v) -> sprintf "%s=%s" (HttpUtility.UrlEncode k) (HttpUtility.UrlEncode v) )
|> String.concat "&"
let output = Encoding.UTF8.GetBytes concatArgs
if DEBUG then printfn "Posting to %s, %A" url concatArgs
http.ContentLength <- int64 output.Length
let stream = http.GetRequestStream()
stream.Write(output, 0, output.Length)
stream.Close()
let response = http.GetResponse().GetResponseStream()
let reader = new StreamReader(response)
let returnString = reader.ReadToEnd()
reader.Close()
returnString
let phabricatorFetch methodName (args: (string * string) list) =
let url = PHABRICATOR_URL + "api/" + methodName + "?api.token=" + CONDUIT_TOKEN
let response = fetch url args
let json = JsonValue.Parse response
match json?result with
| JsonValue.Null -> failwithf "Could not parse Phabricator response %s" response
| x -> x
let stringsEqual (a:string) (b:string) =
a.ToLowerInvariant() = b.ToLowerInvariant()
let toString x = sprintf "%O" x
type Phabricator = {
Users: (string * string * PhabUser.Root) list
Projects: (string * string * PhabProject.Root) list
} with
static member Connect() =
{
Users =
phabricatorFetch "user.query" []
|> toString
|> PhabUser.Parse
|> Array.toList
|> List.map (fun x -> x.UserName, x.Phid, x)
Projects =
phabricatorFetch "project.query" []
|> toString
|> JsonValue.Parse
|> fun x -> x?data.Properties
|> Array.toList
|> List.map (fun (key,thing) ->
let stuff = thing.ToString() |> PhabProject.Parse
stuff.Name, stuff.Phid, stuff)
}
member self.LookupProject name =
self.Projects
|> List.tryPick (fun (n,_,p) -> if stringsEqual n name then Some p else None)
member self.LookupUser name =
self.Users
|> List.tryPick (fun (n,_,u) -> if stringsEqual n name then Some u else None)
member self.Run command args =
phabricatorFetch command args
member self.CreateTask args =
self.Run "maniphest.createtask" args
member self.UpdateTask args =
self.Run "maniphest.update" args
member self.SearchTask args =
self.Run "maniphest.query" args
|> function
| JsonValue.Array [| |] -> [| |]
| JsonValue.Record x -> x
| f -> failwithf "Expected array from search, got %A" f
type Comment = {
Description: string
Username: string option
Date: System.DateTime option
} with
static member Create x =
{ Description = x; Username = None; Date = None}
/// The bucket we'll hold information in
type Ticket = {
OriginalId: string
Title: string
Project: string
Area: string
Category: string
Tags: string
Priority: string
LatestSummary: string
Comments: Comment list
FixFor: string
AssignedUsername: string option
} with
member self.PhabricatorPriority =
match self.Priority with
| "1" -> 100
| "2" -> 80
| "3" | "4" -> 50
| "5" | "6" -> 25
| _ -> 90
let import user pass fbProjectName phabProjectName =
let phab = Phabricator.Connect()
let fb = Fogbugz.Connect(user, pass)
let phabricatorProjectId =
match phab.LookupProject phabProjectName with
| None -> failwithf "Can't find phabricator project named %s" phabProjectName
| Some p -> p.Phid
let phabricatorFuture = phab.LookupProject "Future"
let convert (elem:System.Xml.XmlNode) =
let find = xfind elem
let ixBug = find "ixBug"
let comments =
if ixBug = "" then [] else
let events = fb.Search(ixBug, Some "events,ixPerson,dt", MAX_COMMENTS + 1).SelectNodes("//event");
[ for e in events do
let text = e.SelectNodes("s")
let date = e.SelectNodes("dt")
let ixPerson = e.SelectNodes("ixPerson")
yield {
Description =
[
for t in text do
let trimmed = t.InnerText.Trim()
if trimmed <> "" then
yield trimmed
] |> String.concat "\n\n"
Username =
if ixPerson.Count > 0 then
fb.LookupUser ixPerson.[0].InnerText
else
None
Date =
if date.Count > 0 then
Some (System.DateTime.Parse(date.[0].InnerText))
else
None
}
]
{
OriginalId = find "ixBug"
Title = find "sTitle"
Project = find "sProject"
FixFor = find "sFixFor"
Area = find "sArea"
Category = find "sCategory"
Tags = find "sTags"
Priority = find "ixPriority"
LatestSummary = find "sLatestTextSummary"
Comments = comments
AssignedUsername = fb.LookupUser (find "ixPersonAssignedTo")
}
let jsonString (x:string) =
//x.Replace("\"", "\\\"")
x
|> JsonValue.String
let jsonEscape (x:string) =
(jsonString x).ToString()
let toManiphestArgs t =
let originalUrl = sprintf "http://fogbugz/default.asp?%s" t.OriginalId
let comments =
if t.Comments.Length > MAX_COMMENTS then
(
Seq.truncate MAX_COMMENTS t.Comments
|> List.ofSeq
)
@ [ Comment.Create <| sprintf "[[ %s | Comments have been TRUNCATED. Please go to the original fogbugz ticket to see more comments. ]]" originalUrl ]
else
t.Comments
|> List.choose
(fun c ->
let phabUser = phab.LookupUser (defaultArg c.Username "")
let userName = phabUser |> Option.map (fun x -> "@" + x.UserName)
if c.Description.Trim() = "" then None else
let date = c.Date |> Option.map (fun x -> x.ToLocalTime().ToString("**yyyy-MM-dd** HH:mm"))
Some <|
sprintf "**%s** %s\n%s"
(defaultArg userName "Unknown user")
(defaultArg date "Unknown date")
c.Description
)
|> String.concat "\n\n-----\n\n"
let description =
(sprintf "# [[ %s | From Fogbugz: %s ]]\n\n" originalUrl t.OriginalId)
+ (sprintf "FB Milestone: **%s**\n\n" t.FixFor)
+ (sprintf "FB Area: **%s**\n\n" t.Area)
+ (if t.Tags.Equals "" then "" else (sprintf "FB Tags: **%s**\n\n" t.Tags))
+ (sprintf "# Description:\n\n %s" comments)
let projects = [|
yield phabricatorProjectId
match t.FixFor with
| "Future" ->
match phabricatorFuture with
| Some i -> yield i.Phid
| _ -> failwith "Couldn't find future project"
| _ -> ()
|]
let projectsStupidPhpEncoding =
projects
|> Seq.mapi (fun i p -> sprintf "projectPHIDs[%i]" i, p)
[
yield "title", t.Title
yield "description", description
yield "priority", string t.PhabricatorPriority
yield! projectsStupidPhpEncoding
match t.AssignedUsername with
| Some name ->
match phab.LookupUser name with
| Some user ->
yield "ownerPHID", user.Phid
| _ -> ()
| _ -> ()
]
|> List.map (fun (k,v) -> k, v.ToString())
let xml =
fb.Search(
sprintf """ project:"%s" AND status:"Open" """ fbProjectName,
Some FOGBUGZ_CASE_FIELDS,
MAX_TICKETS
).SelectNodes("/response/cases/case");
for x in xml do
let ticket = convert x
let args = toManiphestArgs ticket
// Find existing imported "from fogbugz" task if it exists
let existing =
phab.SearchTask [ ("fullText", jsonEscape ticket.Title) ]
|> Array.tryFind
( fun (phid,v) ->
match v?description with
| JsonValue.String desc ->
desc.Contains(sprintf "From Fogbugz: %s" ticket.OriginalId)
| _ -> false
)
match existing with
| Some (phid, existingTicket) ->
// pass in the existing Phid so we edit the existing ticket
let editedArgs = ("phid", phid) :: args
let result = phab.UpdateTask editedArgs
printfn "Task updated for ticket %s %s: %A" ticket.OriginalId ticket.Title result
| None ->
let result = phab.CreateTask args
printfn "Task created for ticket %s %s: %A" ticket.OriginalId ticket.Title result
[<EntryPoint>]
let main argv =
import argv.[0] argv.[1] "Slate Publisher" "Publisher"
0