diff --git a/jam-utils.xqy b/jam-utils.xqy new file mode 100644 index 0000000..bf74b2a --- /dev/null +++ b/jam-utils.xqy @@ -0,0 +1,501 @@ +xquery version "0.9-ml" + +(:~ + : Library of utility functions written on top of MLJAM + : + : For a tutorial please see + : http://xqzone.marklogic.com/howto/tutorials/2006-05-mljam.xqy. + : + : Copyright 2006 Jason Hunter + : + : Licensed under the Apache License, Version 2.0 (the "License"); + : you may not use this file except in compliance with the License. + : You may obtain a copy of the License at + : + : http://www.apache.org/licenses/LICENSE-2.0 + : + : Unless required by applicable law or agreed to in writing, software + : distributed under the License is distributed on an "AS IS" BASIS, + : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + : See the License for the specific language governing permissions and + : limitations under the License. + : + : @author Jason Hunter and Ryan Grimm + : @version 1.0 + :) + +module "http://xqdev.com/jam-utils" +declare namespace jamu = "http://xqdev.com/jam-utils" +default function namespace = "http://www.w3.org/2003/05/xpath-functions" + +import module namespace jam="http://xqdev.com/jam" at "jam.xqy" + +(: Later on I'll probably make these all take an optional second arg + context name, esp since 3.1 will allow optional args :) + +(: metadata should take node, so should xslfo :) + + +(:~ + : Returns the MD5 hash of the specified string, as a hex encoded string. + : Leverates Java's java.security.MessageDigest class. + : + : Depends on jam:start() having previously been called. + : + : @param $x The string on which to do the MD5 hash + : @return The MD5 hash of the given string + :) +define function jamu:encrypt($algorithm as xs:string, $key as xs:string, $data as xs:string, $output as xs:string) as xs:string +{ + (: I use eval-get() to reduce the net hit count by one :) + (: I surround the Java with curly braces and declare all variable types + even though it's optional in order to limit the variable scope to this + context and reduce the chances for collision. :) + jam:set("algorithm", $algorithm), + jam:set("key", $key), + jam:set("data", $data), + jam:set("output", $output), + xs:string( + jam:eval-get('{ + import nl.daidalos.util.Encryption; + + Encryption.encrypt(Encryption.Algorithm.getByName(algorithm), key, data, Encryption.Output.getByName(output)); + }') + ) +} + +(:~ + : Returns the MD5 hash of the specified string, as a hex encoded string. + : Leverates Java's java.security.MessageDigest class. + : + : Depends on jam:start() having previously been called. + : + : @param $x The string on which to do the MD5 hash + : @return The MD5 hash of the given string + :) +define function jamu:md5($x as xs:string) as xs:string +{ + (: I use eval-get() to reduce the net hit count by one :) + (: I surround the Java with curly braces and declare all variable types + even though it's optional in order to limit the variable scope to this + context and reduce the chances for collision. :) + jam:set("md5src", $x), + xs:string( + jam:eval-get('{ + java.security.MessageDigest digest = + java.security.MessageDigest.getInstance("MD5"); + digest.digest(md5src.getBytes("UTF-8")); + }') + ) +} + +(:~ + : Returns the MD5 hash of the specified binary(), as a hex encoded string. + : Leverates Java's java.security.MessageDigest class. + : + : Depends on jam:start() having previously been called. + : + : @param $x The binary() node on which to do the MD5 hash + : @return The MD5 hash of the given string + :) +define function jamu:md5-binary($x as binary()) as xs:string +{ + jam:set("md5src", $x), + xs:string( + jam:eval-get('{ + java.security.MessageDigest digest = + java.security.MessageDigest.getInstance("MD5"); + digest.digest(md5src); + }') + ) +} + + + + +(:~ + : Returns the metadata held within the given image, as an XML + : <metadata> element holding <directory> elements + : each of which holds numerous <tag> elements. Example output: + : + : <exif> + : <metadata> + : <directory name="Exif"> + : <tag name="Make">Canon</tag> + : <tag name="Model">Canon EOS D30</tag> + : <tag name="Date/Time">2002:07:04 19:02:52</tag> + : ... + : </directory> + : <directory name="Canon Makernote"> + : <tag name="Macro Mode">Normal</tag> + : <tag name="Self Timer Delay">Self timer not used</tag> + : <tag name="Focus Mode">One-shot</tag> + : ... + : </directory> + : <directory name="Jpeg"> + : <tag name="Data Precision">8 bits</tag> + : <tag name="Image Height">1080 pixels</tag> + : <tag name="Image Width">720 pixels</tag> + : ... + : </directory> + : </metadata> + : </exif> + : + : Leverates the public domain com.drew.metadata Java library. + : + : Depends on jam:start() having previously been called. + : + : @param $img The binary() node holding the image to investigate + : @return An XML metadata element + :) +define function jamu:get-jpeg-metadata($img as binary()) as element(metadata) +{ + jam:set("exifimg", $img), + jam:eval-get('{ + + import com.drew.metadata.*; + import com.drew.metadata.exif.*; + import com.drew.imaging.jpeg.*; + import org.jdom.Element; + import java.util.*; + + InputStream in = new ByteArrayInputStream(exifimg); + Metadata jmr = JpegMetadataReader.readMetadata(in); + Iterator directories = jmr.getDirectoryIterator(); + + Element exif = new Element("metadata"); + while (directories.hasNext()) { + Directory directory = (Directory)directories.next(); + Element dir = new Element("directory"); + dir.setAttribute("name", directory.getName()); + exif.addContent(dir); + Iterator tags = directory.getTagIterator(); + while (tags.hasNext()) { + Tag tag = (Tag)tags.next(); + Element t = new Element("tag"); + dir.addContent(t); + t.setAttribute("name", tag.getTagName()); + t.setText(tag.getDescription()); + } + } + exif; // return this + + }') +} + + +(:~ + : Applies the specified XSLT stylesheet against the given node and + : returns the result as a document (or within a document). The processing + : takes place in the remote Java context using JAXP and TrAX. + : Callers are advised to set + : <xsl:output method="xml" encoding="UTF-8"/>. + : Beware that because the stylesheet is passed in as an argument, the sheet + : will not be able to pull on external resources. + : + : Depends on jam:start() having previously been called. + : + : Note: Some JAXP engines seem to have problems handling PIs in that it + : forgets to add the second questoin mark. + : + : @param $node The node on which to do the transform + : @param $sheet The stylesheet to apply + : @return A document result from the transformation + :) +define function jamu:xslt-sheet($node as node(), $sheet as element()) +as document-node() +{ + jam:set("xsltnode", $node), + jam:set("xsltsheet", $sheet), + + let $retval := + jam:eval-get('{ + + import javax.xml.transform.*; + import javax.xml.transform.stream.StreamSource; + import javax.xml.transform.stream.StreamResult; + + Templates templates = + TransformerFactory.newInstance().newTemplates( + new StreamSource( + new StringReader(xsltsheet))); + + StreamSource source = new StreamSource( + new StringReader(xsltnode)); + + ByteArrayOutputStream baos = new ByteArrayOutputStream(10240); + StreamResult result = new StreamResult(baos); + + templates.newTransformer().transform(source, result); + baos.toByteArray(); // return this + + }') + return xdmp:unquote(xdmp:quote($retval)) +} + + + + +(: + : Private utility function to support all the image resize and convert + : functions. + :) +define function jamu:_image-manipulate( + $img as node(), + $format as xs:string?, + $width as xs:integer?, + $height as xs:integer?, + $maxWidth as xs:integer?, + $maxHeight as xs:integer?, + $percent as xs:integer? +) as binary() +{ + if (not($format = ("png", "jpg", "jpeg", "bmp"))) then + error(concat("Java 5 supports image manipulation output formats png, jpg, and bmp; cannot process: ", $format)) + else (), + + if ($img instance of binary()) then + jam:set("imgbefore", $img) + else if ($img/binary() instance of binary()) then + jam:set("imgbefore", $img/binary()) + else + error("Node to image manipulation must be binary() or doc containing binary()"), + + jam:set("format", $format), + jam:set("width", $width), + jam:set("height", $height), + jam:set("maxWidth", $maxWidth), + jam:set("maxHeight", $maxHeight), + jam:set("percent", $percent), + + jam:eval-get('{ + + import java.awt.*; + import java.awt.image.*; + import javax.imageio.*; + import javax.imageio.stream.*; + + BufferedImage image = ImageIO.read(new ByteArrayInputStream(imgbefore)); + if (image == null) { + throw new RuntimeException("Invalid image content"); + } + + // Use double to force floating point math + double origWidth = image.getWidth(); + double origHeight = image.getHeight(); + + // Now calculate new dimensions depending on passed-in values + double newWidth = origWidth; + double newHeight = origHeight; + + // Note: xs:integer makes long + // Note: Specify just width or height -> keep aspect ratio + + // First, a maxWidth is like a width except it only applies + // when the width exceeds the max. + if (maxWidth != null && maxHeight == null) { + if (maxWidth < origWidth) width = maxWidth; + } + else if (maxHeight != null && maxWidth == null) { + if (maxHeight < origHeight) height = maxHeight; + } + else if (maxHeight != null && maxWidth != null) { + if (maxHeight < origHeight && maxWidth >= origWidth) { + height = maxHeight; // only height max matters + } + else if (maxWidth < origWidth && maxHeight >= origHeight) { + width = maxWidth; // only width max matters + } + else if (maxWidth < origWidth && maxHeight < origHeight) { + // Both matter, find the biggest ratio to know which to use. + double widthRatio = origWidth / maxWidth; + double heightRatio = origHeight / maxHeight; + if (widthRatio > heightRatio) { + width = maxWidth; + } + else { + height = maxHeight; + } + } + } + + // Now apply the width/height math. Includes max work above. + if (width != null && height == null) { + newWidth = width; + newHeight = -1; // newWidth * origHeight / origWidth; + } + else if (height != null && width == null) { + newHeight = (int) height; + newWidth = -1; // newHeight * origWidth / origHeight; + } + else if (width != null && height != null) { + newWidth = (int) width; + newHeight = (int) height; + } + + if (percent != null) { + newHeight = (int) Math.ceil(origHeight * percent / 100.0); + newWidth = (int) Math.ceil(origWidth * percent / 100.0); + } + + Image scaledImage = image.getScaledInstance( + (int)newWidth, (int)newHeight, 0); + + BufferedImage bi = new BufferedImage(scaledImage.getWidth(null), + scaledImage.getHeight(null), BufferedImage.TYPE_INT_RGB); + Graphics g = bi.createGraphics(); + g.drawImage(scaledImage, 0, 0, null); + + ByteArrayOutputStream baos = new ByteArrayOutputStream(10240); + ImageIO.write(bi, format, baos); + + g.dispose(); // takes a bit of time to call but safer + baos.toByteArray(); // return this + + }') +} + + +(:~ + : Returns a copy of the given image that's been converted to the specified + : format. Java 5 supports the output formats "png", "jpg/jpeg", and "bmp". + : Leverages Java's ImageIO class. + : The image can be specified as either a binary() node or a + : document-node() holding a binary() node. + : + : Depends on jam:start() having previously been called. + : + : @param $img A binary() node holding the image to convert + : @param $format One of "png", "jpg/jpeg", or "bmp" + : @return A binary() node holding the converted image + :) +define function jamu:image-convert( + $img as node(), + $format as xs:string) +as binary() +{ + jamu:_image-manipulate($img, $format, (), (), (), (), ()) +} + +(:~ + : Returns a copy of the given image that's been resized to the specified + : (integer) percent size of its original and written to the specified format. + : Java 5 supports the output formats "png", "jpg/jpeg", and "bmp". + : Leverages Java's ImageIO class. + : The image can be specified as either a binary() node or a + : document-node() holding a binary() node. + : + : Depends on jam:start() having previously been called. + : + : @param $img A binary() node holding the image to convert + : @param $percent The size of the new image as a percent of the original + : @param $format One of "png", "jpg/jpeg", or "bmp" + : @return A binary() node holding the converted image + :) +define function jamu:image-resize-percent( + $img as node(), + $percent as xs:integer, + $format as xs:string?) +as binary() +{ + jamu:_image-manipulate($img, $format, (), (), (), (), $percent) +} + +(:~ + : Returns a copy of the given image that's been resized to the specified + : pixel sizes and written to the specified format. If just a width or + : height is given, it means to resize by preserving the aspect ratio. + : Java 5 supports the output formats "png", "jpg/jpeg", and "bmp". + : Leverages Java's ImageIO class. + : The image can be specified as either a binary() node or a + : document-node() holding a binary() node. + : + : Depends on jam:start() having previously been called. + : + : @param $img A binary() node holding the image to convert + : @param $w The new width of the image, or if unspecified allow to float + : based on the specified height + : @param $h The new height of the image, or if unspecified allow to float + : based on the specified width + : @param $format One of "png", "jpg/jpeg", or "bmp" + : @return A binary() node holding the converted image + :) +define function jamu:image-resize-exact( + $img as node(), + $w as xs:integer?, + $h as xs:integer?, + $format as xs:string?) +as binary() +{ + jamu:_image-manipulate($img, $format, $w, $h, (), (), ()) +} + +(:~ + : Returns a copy of the given image that's been resized to completely fit + : within the given pixel sizes, and that's been written to the specified + : format. If the width or height is not given, it means no limit need + : apply. The aspect ratio is always preserved. + : Java 5 supports the output formats "png", "jpg/jpeg", and "bmp". + : Leverages Java's ImageIO class. + : The image can be specified as either a binary() node or a + : document-node() holding a binary() node. + : + : Depends on jam:start() having previously been called. + : + : @param $img A binary() node holding the image to convert + : @param $w The maximum width of the new image + : @param $h The maximum height of the new image + : @param $format One of "png", "jpg/jpeg", or "bmp" + : @return A binary() node holding the converted image + :) +define function jamu:image-resize-max( + $img as node(), + $w as xs:integer?, + $h as xs:integer?, + $format as xs:string?) +as binary() +{ + jamu:_image-manipulate($img, $format, (), (), $w, $h, ()) +} + + +(:~ + : Returns a PDF generated from the given XSL-FO element using the Apache + : FOP 0.92 engine. + : + : Depends on jam:start() having previously been called. + : + : @param $xslfo The XSL-FO element to render as PDF + : @return A binary() node holding the generated PDF document + :) +define function jamu:fop( + $xslfo as element() +) +as binary() +{ + (: Takes about 1.5 secs to handle a 28 page PDF of a book chapter. + Nearly all that time is in the transform() call. :) + jam:set("xslfo", $xslfo), + jam:eval-get('{ + + import org.apache.fop.apps.*; + import javax.xml.transform.*; + import javax.xml.transform.sax.SAXResult; + import javax.xml.transform.stream.StreamSource; + import org.xml.sax.*; + + Transformer trans = TransformerFactory.newInstance().newTransformer(); + + Source source = new StreamSource(new StringReader(xslfo)); + + FopFactory fopFactory = FopFactory.newInstance(); + ByteArrayOutputStream baos = new ByteArrayOutputStream(10240); + Fop fop = fopFactory.newFop(MimeConstants.MIME_PDF, baos); + + Result res = new SAXResult(fop.getDefaultHandler()); + trans.transform(source, res); + + baos.toByteArray(); // return this + + }') +} diff --git a/jam.xqy b/jam.xqy new file mode 100644 index 0000000..1f8cffc --- /dev/null +++ b/jam.xqy @@ -0,0 +1,729 @@ +xquery version "0.9-ml" + +(:~ + : Mark Logic Interface to Java + : + : For a tutorial please see + : http://xqzone.marklogic.com/howto/tutorials/2006-05-mljam.xqy. + : + : Copyright 2006-2007 Jason Hunter and Ryan Grimm + : + : Licensed under the Apache License, Version 2.0 (the "License"); + : you may not use this file except in compliance with the License. + : You may obtain a copy of the License at + : + : http://www.apache.org/licenses/LICENSE-2.0 + : + : Unless required by applicable law or agreed to in writing, software + : distributed under the License is distributed on an "AS IS" BASIS, + : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + : See the License for the specific language governing permissions and + : limitations under the License. + : + : @author Jason Hunter and Ryan Grimm + : @version 1.2 + :) + +module "http://xqdev.com/jam" +declare namespace jam = "http://xqdev.com/jam" +default function namespace = "http://www.w3.org/2003/05/xpath-functions" + +(:~ + : Holds the randomly generated context id for when the user doesn't + : specify a context id. + :) +define variable $default-context as xs:string { "" } + +(:~ + : Holds the mapping between context ids and web addresses, as setup + : by the jam:start() function. + :) +define variable $urlmap as element(urlmap) { } + +(: + : Private utility function that returns true() if the passed-in string + : contains only whitespace. For efficiency it actually only checks the + : leading 4k of the string. + : + : @param $s String to check for whitespace + : @return true() if the string is all whitespace, false() if not + :) +define function jam:_is-all-whitespace( + $s as xs:string +) as xs:boolean +{ + (: OK, we cheat a little so we don't normalize a huge string :) + normalize-space(substring($s, 0, 4096)) = "" +} + +(:~ + : Assigns a variable in the specified remote Java context. XQuery + : types are mapped to Java types according to the following table + : (setting other types generates an error): + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + :
xs:anyURI String
xs:base64Binary byte[]
xs:boolean boolean
xs:date javax.xml.datatype.XMLGregorianCalendar
xs:dateTime javax.xml.datatype.XMLGregorianCalendar
xs:decimal BigDecimal
xs:double double
xs:duration javax.xml.datatype.Duration
xs:float float
xs:gDay javax.xml.datatype.XMLGregorianCalendar
xs:gMonth javax.xml.datatype.XMLGregorianCalendar
xs:gMonthDay javax.xml.datatype.XMLGregorianCalendar
xs:gYear javax.xml.datatype.XMLGregorianCalendar
xs:gYearMonth javax.xml.datatype.XMLGregorianCalendar
xs:hexBinary byte[]
xs:int int
xs:integer long
xs:QName javax.xml.namespace.QName
xs:string String
xs:time javax.xml.datatype.XMLGregorianCalendar
xdt:dayTimeDuration javax.xml.datatype.Duration
xdt:untypedAtomic String
xdt:yearMonthDuration javax.xml.datatype.Duration
attribute() String holding its xdmp:quote() value
comment() String holding its xdmp:quote() value
document-node() String holding its xdmp:quote() value
element() String holding its xdmp:quote() value
processing-instruction() String holding its xdmp:quote() value
text() String holding its xdmp:quote() value
binary() byte[]
() null
+ : + : If the XQuery $value holds a sequence of values, it's passed to Java as + : an Object[] array holding instances of the above types (with primitives + : autoboxed). + : + : If the XQuery $value holds a value mapped to String or byte[] it's sent + : on the wire in an optimized fashion (not possible when in an array). + : + : Note that in XQuery there's no difference between an item and a sequence + : of length one containing that item. If you want to assign an XQuery + : sequence to a Java array and it might be a single item in XQuery, use + : jam:set-array() or jam:set-array-in(). These pass the value as an array + : even if the sequence happens to be of length one. + : + : @param $var Name of variable to set, must be a legal Java token + : @param $value Value to assign for the variable + : @param $context Named context in which to do the assignment, or the + : default context if not specified + :) +define function jam:set-in( + $var as xs:string, + $value as item()*, + $context as xs:string +) as empty() +{ + (: Check for single string optimization. :) + (: We do this because it takes a full minute per meg to eval() a string + on my laptop. This way the BeanShell can receive it directly. :) + (: Note that sending an array of strings won't be as efficient. :) + (: If it's all whitespace we have trouble posting, so don't optimize. :) + if ($value instance of xs:string and + not(jam:_is-all-whitespace($value))) then + jam:_call("post", $context, "set-string", $var, $value) + + (: We optimize sending a binary() also :) + (: We check for xs:hexBinary with describe() because untypedAtomic + values can be converted wrongly and may contain whitespace that + messes up the post body (like above). :) + else if ($value instance of binary() or + ($value instance of document-node() and + $value/binary() instance of binary()) or + starts-with(xdmp:describe($value), "xs:hexBinary")) then + jam:_call("post", $context, "set-binary", $var, + xs:string($value) (: server knows to decode the hexBinary :) + ) + + (: Lastly, we optimize sending a single node, just like a string :) + else if ($value instance of node()) then + jam:_call("post", $context, "set-string", $var, xdmp:quote($value)) + + (: If we're some other type or an array, create an expression to eval :) + else + jam:_call("post", $context, "eval", (), + concat('unset("', $var, '"); ', $var, ' = ', jam:_get-java($value), ';') + ) +} + +(:~ + : Special form of jam:set-in() that passes the value as a Java array even + : if it's a sequence of length one. Java will see the variable as an Object[]. + : + : @param $var Name of variable to set, must be a legal Java token + : @param $value Value to assign for the variable + : @param $context Named context in which to do the assignment, or the + : default context if not specified + :) +define function jam:set-array-in( + $var as xs:string, + $value as item()*, + $context as xs:string +) as empty() +{ + (: Treat $value as an array regardless of its actual length. :) + jam:_call("post", $context, "eval", (), + concat('unset("', $var, '"); ', $var, ' = ', jam:_get-java-array($value), ';') + ) +} + +(: + : Private utility function to support set-array(), by mapping XQuery data types + : to a Java array expression. + :) +define function jam:_get-java-array( + $value as item()* +) as xs:string +{ + concat('new Object[] { ', (: Might want to choose more specific type :) + string-join(for $i in $value return jam:_get-java($i), ', ') + , ' }') +} + +(: + : Private utility function to support set(), by mapping XQuery data types + : to a Java expression. + :) +define function jam:_get-java( + $value as item()* +) as xs:string +{ + if (count($value) > 1) then + concat('new Object[] { ', (: Might want to choose more specific type :) + string-join(for $i in $value return jam:_get-java($i), ', ') + , ' }') + else + + if (empty($value)) then + 'null' + + else if ($value instance of xs:string or + $value instance of xs:anyURI or + $value instance of xdt:untypedAtomic) then + concat('"', jam:_escape-string(xs:string($value)), '"') + + else if ($value instance of xs:boolean) then + string($value) + + else if ($value instance of xs:double) then + if ($value = xs:double("INF")) then + 'Double.POSITIVE_INFINITY' + else if ($value = xs:double("-INF")) then + 'Double.NEGATIVE_INFINITY' + else if (jam:_isNaN($value)) then + 'Double.NaN' + else + concat(string($value), 'D') + + else if ($value instance of xs:float) then + if ($value = xs:float("INF")) then + 'Float.POSITIVE_INFINITY' + else if ($value = xs:float("-INF")) then + 'Float.NEGATIVE_INFINITY' + else if (jam:_isNaN($value)) then + 'Float.NaN' + else + concat(string($value), 'F') + + else if ($value instance of xs:int) then + string($value) + + (: Little special handling since ML 3.0 doesn't throw cast errors :) + else if ($value instance of xs:integer) then + if ($value <= 9223372036854775807) then + concat(string($value), 'L') + else + concat('new java.math.BigDecimal("', string($value), '")') + + else if ($value instance of xs:decimal) then + concat('new java.math.BigDecimal("', string($value), '")') + + else if ($value instance of xs:QName) then + concat('new javax.xml.namespace.QName("', + get-namespace-from-QName($value), '","', + get-local-name-from-QName($value), '","', + substring-before(xs:string($value), ":"), '")') + + (: Note on Xerces and gMonth... + Xerces doesn't like "--01" as a gMonth but rather "--01--" which is + erroneous according to http://www.w3.org/2001/05/xmlschema-errata#e2-12. + We choose to send using the new lexical form, as output by MarkLogic, + and trust that newer Xerces versions will understand. :) + else if ($value instance of xs:gDay or + $value instance of xs:gMonth or (: gMonth fails on old xerces :) + $value instance of xs:gYear or + $value instance of xs:date or + $value instance of xs:dateTime or + $value instance of xs:time or + $value instance of xs:gMonthDay or + $value instance of xs:gYearMonth) then + concat('javax.xml.datatype.DatatypeFactory.newInstance()', + '.newXMLGregorianCalendar("', string($value), '")') + + (: Note on Xerces and durations... + The Xerces Duration.getXMLSchemaType() method gets confused on + durations like "P1D" because it thinks only the day value is set + and thinks that's illegal. We could fix this by munging the string + form to be exhaustive, but it doesn't seem to really matter. :) + else if ($value instance of xs:duration or + $value instance of xdt:dayTimeDuration or + $value instance of xdt:yearMonthDuration) then + concat('javax.xml.datatype.DatatypeFactory.newInstance()', + '.newDuration("', string($value), '")') + + (: This code assumes a hexdecode() function available in the BeanShell + context, implemented by something such as this Jakarta Commons class: + http://svn.apache.org/viewcvs.cgi/jakarta/commons/proper/codec/ + trunk/src/java/org/apache/commons/codec/binary/Hex.java + ?rev=161350&view=markup :) + else if ($value instance of binary() or + ($value instance of document-node() and + $value/binary() instance of binary()) or + $value instance of xs:hexBinary) then + concat('hexdecode("', xs:string($value), '")') + + (: This code assumes a base64decode() function. + We could convert it in MarkLogic to hexBinary but that's less efficient. + Plus, MarkLogic built-ins only let you decode to a string, limiting. + My COS library includes a base64 decoder, as does Jakarta. :) + else if ($value instance of xs:base64Binary) then + concat('base64decode("', xs:string($value), '")') + + (: Any other type of node :) + else if ($value instance of node()) then + concat('"', jam:_escape-string(xdmp:quote($value)), '"') + + else + error(concat("Unhandled type: ", xdmp:describe($value))) +} + + +(:~ + : Executes the given Java code in the specified remote Java context. + : For execution that returns a value, eval-get-in() may be more optimal. + : Hint: it's often best to surround the Java code string to evaluate + : with single quotes rather than double quotes. Then only single quotes + : have to be escaped (by writing two single quotes in a row). + : + : @param $expr Java expression to evaluate + : @param $context Named context in which to do the evaluation, or the + : default context if not specified + :) +define function jam:eval-in( + $expr as xs:string, + $context as xs:string +) as empty() +{ + jam:_call("post", $context, "eval", (), $expr) +} + + +(:~ + : Executes the given Java code in the specified remote Java context, + : and returns the value from last statement evaluated. + : Hint: it's often best to surround the Java code string to evaluate + : with single quotes rather than double quotes. Then only single quotes + : have to be escaped (by writing two single quotes in a row). + : + : @param $expr Java expression to evaluate + : @param $context Named context in which to do the evaluation, or the + : default context if not specified + : @return The value from the last statement evaluated + :) +define function jam:eval-get-in( + $expr as xs:string, + $context as xs:string +) as item()* +{ + jam:_call("post", $context, "eval-get", (), $expr) +} + + +(:~ + : Unassigns the named variable from the specified remote Java context. + : + : @param $var Name of variable to unset, must be a legal Java token + : @param $context Named context in which to do the unset, or the + : default context if not specified + :) +define function jam:unset-in( + $var as xs:string, + $context as xs:string +) as empty() +{ + jam:_call("post", $context, "unset", $var, ()) +} + + +(:~ + : Retrieves the value of the named parameter from the specified remote + : Java context. Java types are mapped to XQuery types according to the + : following table (getting other types generates an error): + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + : + :
byte[] binary()
BigDecimal xs:decimal
boolean xs:boolean
double xs:double
float xs:float
int xs:int
long xs:integer
Date xs:dateTime
String xs:string
JDOM Attribute attribute()
JDOM Comment comment()
JDOM Document document-node()
JDOM Element element()
JDOM PI processing-instruction()
JDOM Text text()
XMLGregorianCalendar xs:dateTime, xs:time, xs:date, + : xs:gYearmonth, xs:gMonthDay, + : xs:gYear, xs:gMonth, + : or xs:gDay depending on + : getXMLSchemaType()
Duration xs:duration, xdt:dayTimeDuration, or + : xdt:yearMonthDuration depending on + : getXMLSchemaType()
QName xs:QName
null ()
+ : + : If the Java variable holds an array, it's returned to XQuery as a + : sequence. + : + : If the Java variable holds a String or byte[] it's sent on the wire + : in an optimized fashion (not possible when in an array). + : + : @param $var Name of variable to get, must be a legal Java token + : @param $context Named context from which to do the get, or the + : default context if not specified + :) +define function jam:get-in( + $var as xs:string, + $context as xs:string +) as item()* +{ + jam:_call("get", $context, "get", $var, ()) +} + + +(:~ + : Enables JAM usage by creating a mapping between a web address and a + : context id. Later calls to the named context will connect to the given + : web address for execution. This function allows the same XQuery to + : connect to multiple different servers, and manage multiple contexts on + : each. This function does all its work locally and does not actually + : connect to the given web address. + : + : @param $url Web address to communicate with for the given context + : @param $user Login username to use on server, or () if none + : @param $pass Login password to use on server, or () if none + : @param $context Name of the context + :) +define function jam:start-in( + $url as xs:string, + $user as xs:string?, + $pass as xs:string?, + $context as xs:string +) as empty() +{ + (: + The urlmap looks like this: + + + http://localhost:8080/jam + admin + secret + + + http://localhost:8080/jam + + + + + :) + xdmp:set($urlmap, + + { $urlmap/host except $urlmap/host[@context = $context] } + + {$url} + {$user} + {$pass} + + ) +} + + +(:~ + : Allows the Java server to reclaim the resources associated w/ the + : specified remote Java context. Should be called at the end of each + : XQuery unless the context needs to persist into other queries. + : If not called, the server does periodic sweeps to end contexts + : that haven't been touched within some period of time. + : + : @param $context Named context whose resources can be freed + :) +define function jam:end-in( + $context as xs:string +) as empty() +{ + jam:_call("post", $context, "end", (), ()) +} + + +(:~ + : Returns the content that's been written to standard out in the specified + : remote Java context. Each call clears the buffer. For efficiency reasons + : only the last 10k of content is retained. Only captures output + : from print(), not System.out.println() due to BeanShell limitations. + : + : @param $context Named context whose stdout should be retrieved + : @return The latest standard out output + :) +define function jam:get-stdout-in( + $context as xs:string +) as xs:string +{ + jam:_call("get", $context, "get-stdout", (), ()) +} + + +(:~ + : Returns the content that's been written to standard error in the specified + : remote Java context. Each call clears the buffer. For efficiency reasons + : only the last 10k of content is retained. Only captures output + : from error(), not System.err.println() due to BeanShell limitations. + : + : @param $context Named context whose stdout should be retrieved + : @return The latest standard error output + :) +define function jam:get-stderr-in( + $context as xs:string +) as xs:string +{ + jam:_call("get", $context, "get-stderr", (), ()) +} + + +(:~ + : Loads the named BeanShell source file, for loading useful functions. + : Beware the source file is relative to the server, not the client. + : Also beware windows paths should begin with the drive letter. + : + : @param $bsh File path from which to load a supporting .bsh script + : @param $context Named context whose stdout should be retrieved + :) +define function jam:source-in( + $bsh as xs:string, + $context as xs:string +) as empty() +{ + jam:_call("post", $context, "source", $bsh, ()) +} + + +(: + : Private function to return the random context id for this XQuery + : context. Once generated, values are held in $default-context. + :) +define function jam:_get-default-context() as xs:string +{ + (: We'll let random numbers work for now :) + if ($default-context = "") + then xdmp:set($default-context, concat("temp:", xs:string(xdmp:random()))) + else (), + $default-context +} + +(: + : Private function that handles the HTTP work necessary to communicate + : between XQuery and the remote Java context. + :) +define function jam:_call( + $method as xs:string, (: get or post :) + $context as xs:string, + $verb as xs:string, + $name as xs:string?, + $body as xs:string? +) as item()* +{ + let $base := string($urlmap/host[@context = $context]/url) + return + if ($base = "") then error(concat("Uninitialized context: ", $context)) else + + let $user := string($urlmap/host[@context = $context]/user) + let $pass := string($urlmap/host[@context = $context]/pass) + let $authentication := + if ($user != "" and $pass != "") then + + {$user} + {$pass} + + else if ($user = "" and $pass = "") then + () + else if ($user = "") then + error("Credentials corrupt, cannot have password without user") + else + error("Credentials corrupt, cannot have user without password") + + (: We check body = "" to enable set("x", "") calls to empty post :) + let $options := + if (empty($body) or $body = "") then + + { $authentication } + 10 + + else + (: Design bug: ML requires non-whitespace text :) + + { $authentication } + 30 + text/plain; charset=UTF-8 + {$body} + + + let $url := concat($base, "/", $context, "/", $verb, + if (string-length($name) > 0) then + concat("?name=", xdmp:url-encode($name)) + else + "") + + let $response := + if (lower-case($method) = "get") then + xdmp:http-get($url, $options) + else if (lower-case($method) = "post") then + xdmp:http-post($url, $options) + else error(concat("Unrecognized method: ", $method)) + + let $code := xs:integer($response[1]/*:code) + return + if ($code = 204) then (: no content :) + () + else if ($code = 200) then + if (starts-with(string($response[1]//*:headers/*:content-type), + "x-marklogic/xquery")) then + ( + (: xdmp:log(xdmp:quote($response[2]/binary())), :) + xdmp:eval(xdmp:quote($response[2]/binary())) + ) + else + let $ans := $response[2]/(binary()|text()|*) (: thing under doc node :) + return + if ($ans instance of text()) then xdmp:quote($ans) else $ans + (: Had xs:string($ans) but there's a bug that it returned an old value :) + else + error($response[2]) (: wish cq did a better job with this :) +} + +(: + : Private function that escapes an XQuery string such that it can be + : evaluated in a Java context as a string. Escapes backslashes, double + : quotes, and newlines. + :) +define function jam:_escape-string( + $s as xs:string +) as xs:string +{ + (: These replaces funny because arg2 is a regexp and arg3 is a literal :) + let $s := replace($s, '\\', '\\\\') (: \ replaced with \\ :) + let $s := replace($s, '"', '\\"') (: " replaced with \" :) + let $s := replace($s, ' ', '\\n') + return $s +} + +(: + : Private function that checks if a value is NaN (not a number). + :) +define function jam:_isNaN( + $x +) as xs:boolean +{ + not($x <= 0) and not($x >= 0) +} + + + + + +(: Default context functions, that all pass through to *-in varieties :) + +define function jam:set( + $var as xs:string, + $value as item()* +) as empty() +{ + jam:set-in($var, $value, jam:_get-default-context()) +} + +define function jam:set-array( + $var as xs:string, + $value as item()* +) as empty() +{ + jam:set-array-in($var, $value, jam:_get-default-context()) +} + +define function jam:eval( + $expr as xs:string +) as empty() +{ + jam:eval-in($expr, jam:_get-default-context()) +} + +define function jam:eval-get( + $expr as xs:string +) as item()* +{ + jam:eval-get-in($expr, jam:_get-default-context()) +} + +define function jam:unset( + $var as xs:string +) as empty() +{ + jam:unset-in($var, jam:_get-default-context()) +} + +define function jam:get( + $var as xs:string +) as item()* +{ + jam:get-in($var, jam:_get-default-context()) +} + +define function jam:start( + $url as xs:string, + $user as xs:string?, + $pass as xs:string? +) as empty() +{ + jam:start-in($url, $user, $pass, jam:_get-default-context()) +} + +define function jam:end() as empty() +{ + jam:end-in(jam:_get-default-context()) +} + +define function jam:get-stdout() as xs:string +{ + jam:get-stdout-in(jam:_get-default-context()) +} + +define function jam:get-stderr() as xs:string +{ + jam:get-stderr-in(jam:_get-default-context()) +} + +define function jam:source( + $bsh as xs:string +) as empty() +{ + jam:source-in($bsh, jam:_get-default-context()) +} + diff --git a/oauth-ml6.xqy b/oauth-ml6.xqy new file mode 100644 index 0000000..5838359 --- /dev/null +++ b/oauth-ml6.xqy @@ -0,0 +1,252 @@ +xquery version "1.0-ml"; + +module namespace oa="http://marklogic.com/ns/oauth"; + +declare namespace xh="xdmp:http"; + +declare default function namespace "http://www.w3.org/2005/xpath-functions"; + +declare option xdmp:mapping "false"; + +(: + let $service := + + + http://twitter.com/oauth/request_token + GET + + + http://twitter.com/oauth/authorize + + + http://twitter.com/oauth/authenticate + force_login=true + + + http://twitter.com/oauth/access_token + POST + + + HMAC-SHA1 + + 1.0 + + YOUR-CONSUMER-KEY + YOUR-CONSUMER-SECRET + + +:) + +declare function oa:timestamp() as xs:unsignedLong { + let $epoch := xs:dateTime('1970-01-01T00:00:00Z') + let $now := current-dateTime() + let $d := $now - $epoch + let $seconds + := 86400 * days-from-duration($d) + + 3600 * hours-from-duration($d) + + 60 * minutes-from-duration($d) + + seconds-from-duration($d) + return + xs:unsignedLong($seconds) +}; + +declare function oa:sign($key as xs:string, $data as xs:string) as xs:string { + xdmp:hmac-sha1($key, $data, "base64") +}; + +declare function oa:signature-method( + $service as element(oa:service-provider) +) as xs:string +{ + if ($service/oa:signature-methods/oa:method = "HMAC-SHA1") + then "HMAC-SHA1" + else error(xs:QName("oa:BADSIGMETHOD"), + "Service must support 'HMAC-SHA1' signatures.") +}; + +declare function oa:http-method( + $proposed-method as xs:string +) as xs:string +{ + if (upper-case($proposed-method) = "GET") + then "GET" + else if (upper-case($proposed-method) = "POST") + then "POST" + else error(xs:QName("oa:BADHTTPMETHOD"), + "Service must use HTTP GET or POST.") +}; + +declare function oa:request-token( + $service as element(oa:service-provider), + $callback as xs:string?) +as element(oa:request-token) +{ + let $options := if (empty($callback)) + then () + else + + {$callback} + + let $data + := oa:signed-request($service, + $service/oa:request-token/oa:method, + $service/oa:request-token/oa:uri, + $options, (), ()) + return + + { if ($data/oa:error) + then + $data/* + else + for $pair in tokenize($data, "&") + return + element { concat("oa:", substring-before($pair, '=')) } + { substring-after($pair, '=') } + } + +}; + +declare function oa:access-token( + $service as element(oa:service-provider), + $request as element(oa:request-token), + $verifier as xs:string) +as element(oa:access-token) +{ + let $options := {$verifier} + let $data + := oa:signed-request($service, + $service/oa:access-token/oa:method, + $service/oa:access-token/oa:uri, + $options, + $request/oa:oauth_token, + $request/oa:oaauth_token_secret) + return + + { if ($data/oa:error) + then + $data/* + else + for $pair in tokenize($data, "&") + return + element { concat("oa:", substring-before($pair, '=')) } + { substring-after($pair, '=') } + } + +}; + +declare function oa:signed-request( + $service as element(oa:service-provider), + $method as xs:string, + $serviceuri as xs:string, + $options as element(oa:options)?, + $token as xs:string?, + $secret as xs:string?) +as element(oa:response) +{ + let $realm := string($service/@realm) + let $noncei := xdmp:hash64(concat(current-dateTime(),string(xdmp:random()))) + let $nonce := xdmp:integer-to-hex($noncei) + let $stamp := oa:timestamp() + let $key := string($service/oa:authentication/oa:consumer-key) + let $sigkey := concat($service/oa:authentication/oa:consumer-key-secret, + "&", if (empty($secret)) then "" else $secret) + let $version := string($service/oa:oauth-version) + let $sigmethod := oa:signature-method($service) + let $httpmethod := oa:http-method($method) + + let $sigstruct + := + {$key} + {$nonce} + {$sigmethod} + {$stamp} + {$version} + { if (not(empty($token))) + then {$token} + else () + } + { if (not(empty($options))) + then $options/* + else () + } + + + let $encparams + := for $field in $sigstruct/* + order by local-name($field) + return + concat(local-name($field), "=", encode-for-uri(string($field))) + + let $sigbase := string-join(($httpmethod, encode-for-uri($serviceuri), + encode-for-uri(string-join($encparams,"&"))), "&") + + let $signature := encode-for-uri(oa:sign($sigkey, $sigbase)) + + (: This is a bit of a pragmatic hack, what is the real answer? :) + let $authfields := $sigstruct/*[starts-with(local-name(.), "oauth_") + and not(self::oauth_callback)] + + let $authheader := concat("OAuth realm="", $service/@realm, "", ", + "oauth_signature="", $signature, "", ", + string-join( + for $field in $authfields + return + concat(local-name($field),"="", encode-for-uri($field), """), + ", ")) + + let $uriparam := for $field in $options/* + return + concat(local-name($field),"=",encode-for-uri($field)) + + (: This strikes me as slightly weird. Twitter wants the parameters passed + encoded in the URI even for a POST. I don't know if that's a Twitter + quirk or the natural way that OAuth apps work. Anyway, if you find + this library isn't working for some other OAuth'd API, you might want + to play with this bit. + + let $requri := if ($httpmethod = "GET") + then concat($serviceuri, + if (empty($uriparam)) then '' + else concat("?",string-join($uriparam,"&"))) + else $serviceuri + + let $data := if ($httpmethod = "POST" and not(empty($uriparam))) + then {string-join($uriparam,"&")} + else () + :) + + let $requri := concat($serviceuri, + if (empty($uriparam)) then '' + else concat("?",string-join($uriparam,"&"))) + + let $data := () + + let $options := + + {$authheader} + + { $data } + + + let $tokenreq := if ($httpmethod = "GET") + then xdmp:http-get($requri, $options) + else xdmp:http-post($requri, $options) + + (: + let $trace := xdmp:log(concat("requri: ", $requri)) + let $trace := xdmp:log(concat("sigbse: ", $sigbase)) + let $trace := xdmp:log($options) + let $trace := xdmp:log($tokenreq) + :) + + return + + { if (string($tokenreq[1]/xh:code) != "200") + then + ({$tokenreq[1]}, + {$tokenreq[2]}) + else + $tokenreq[2] + } + +}; diff --git a/oauth.xqy b/oauth.xqy index 0a840e4..bbaee54 100644 --- a/oauth.xqy +++ b/oauth.xqy @@ -2,12 +2,24 @@ xquery version "1.0-ml"; module namespace oa="http://marklogic.com/ns/oauth"; +import module namespace jamu = "http://xqdev.com/jam-utils" at "jam-utils.xqy"; + declare namespace xh="xdmp:http"; declare default function namespace "http://www.w3.org/2005/xpath-functions"; declare option xdmp:mapping "false"; +declare variable $oa:perl-sign-uri := "http://localhost:8190/cgi-bin/hmac-sha1"; +declare variable $oa:jam-sign-uri := "http://localhost:9094/cgi-bin/hmac-sha1"; +declare variable $oa:jam-sign-user := "local"; +declare variable $oa:jam-sign-pass := "lacol"; + +(: +declare variable $oa:sign-mode := "perl"; +:) +declare variable $oa:sign-mode := "jam"; + (: let $service := @@ -51,7 +63,16 @@ declare function oa:timestamp() as xs:unsignedLong { }; declare function oa:sign($key as xs:string, $data as xs:string) as xs:string { - let $uri := concat("http://localhost:8190/cgi-bin/hmac-sha1?", + if ($oa:sign-mode eq "perl") then + oa:sign-pl($key, $data) + else if ($oa:sign-mode eq "jam") then + oa:sign-jam($key, $data) + else + error(xs:QName("oa:UNKNOWNSIGNMODE"), concat("OAuth config error: sign mode '", $oa:sign-mode, "' not supported")) +}; + +declare function oa:sign-pl($key as xs:string, $data as xs:string) as xs:string { + let $uri := concat($oa:perl-sign-uri, "?", "key=", encode-for-uri($key), "&data=",encode-for-uri($data)) let $resp := xdmp:http-get($uri) @@ -59,6 +80,11 @@ declare function oa:sign($key as xs:string, $data as xs:string) as xs:string { string($resp/digest/hashb64) }; +declare function oa:sign-jam($key as xs:string, $data as xs:string) as xs:string { + jam:start($oa:jam-sign-uri, $oa:jam-sign-user, $oa:jam-sign-pass), + jamu:encrypt("HmacSHA1", $key, $data) +}; + declare function oa:signature-method( $service as element(oa:service-provider) ) as xs:string