FogbugzToPhabricator.fs
ActivePublic
Actions

Authored by dgfitch on Jun 1 2015, 8:39 PM.

Tags

None

Referenced Files

	F463264: FogbugzToPhabricator.fs
	Jun 1 2015, 8:45 PM

	F463234: FogbugzToPhabricator.fs
	Jun 1 2015, 8:39 PM

Subscribers

None

	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.

	## Usage:

	- Update the constants below.
	- Run on a per-project basis like:

	`FogbugzToPhabricator.exe "FogbugzUser" "FogbugzPassword" "Fogbugz Project Name" "Phabricator Project Name"`


	## 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] argv.[2] argv.[3]
	0

Event Timeline

dgfitch edited the content of this paste. (Show Details)Jun 1 2015, 8:39 PM

dgfitch changed the title of this paste from untitled to FogbugzToPhabricator.fs.

dgfitch updated the paste's language from autodetect to autodetect.

dgfitch mentioned this in T3179: Importing data from external systems (like GitHub, JIRA, Trac, Asana, Trello, etc.).

dgfitch edited the content of this paste. (Show Details)Jun 1 2015, 8:45 PM

FogbugzToPhabricator.fsActivePublicActions

Event Timeline

FogbugzToPhabricator.fs
ActivePublic
Actions