Initial commit

1 files changed, 1287 insertions, 0 deletions

diff --git a/sys/imio/imt/imxexpand.x b/sys/imio/imt/imxexpand.x
new file mode 100644
index 00000000..72efb17c
--- /dev/null
+++ b/sys/imio/imt/imxexpand.x
@@ -0,0 +1,1287 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<syserr.h>
+include	<imhdr.h>
+include	<imset.h>
+include <mach.h>
+include <fio.h>
+include <finfo.h>
+include	<ctype.h>
+include	<diropen.h>
+
+include "imx.h"
+include <votParse_spp.h>
+
+
+define      SZ_BUF          8192	# name buffer string
+
+
+# IMX_IMEXPAND -- Expand a template of FITS files into a list of image
+# extensions.
+
+pointer procedure imx_imexpand (input, expr, index, extname, extver, ikparams, 
+				section, nimages)
+
+char	input[ARB]			# List of ME file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of extension indexes
+char	extname[ARB]			# Patterns for extension names
+char 	extver[ARB]			# Range list of extension versions
+char	ikparams[ARB]			# Image kernel parameters
+char	section[ARB]			# Image section parameters
+int	nimages				# Number of output images
+
+int	lindex				# List index number?
+int	lname				# List extension name?
+int	lver				# List extension version?
+
+pointer	in, out				# Pointer to output string
+pointer	sp, sif, image, listout
+int	list, len, maxch
+
+int	imx_extns(), strlen(), fntgfnb(), fntlenb()
+pointer	imx_escape()
+bool	imx_sifmatch()
+
+begin
+	call smark (sp)
+	call salloc (in, SZ_FNAME, TY_CHAR)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+
+	lindex  = YES 			# expansion parameters
+	lname   = NO
+	lver    = NO
+	out	= NULL
+	len     = 0
+	nimages = 0
+	maxch   = SZ_LISTOUT
+
+	call aclrc (Memc[in], SZ_FNAME)
+	if (input[1] == '@')
+	    call strcpy (input[2], Memc[in], SZ_FNAME)
+	else
+	    call strcpy (input, Memc[in], SZ_FNAME)
+
+	# Get the list.
+	list = imx_extns (Memc[in], "IMAGE", index, extname, extver, 
+		    lindex, lname, lver, ikparams, section, expr, YES)
+
+	if (list == NULL || fntlenb (list) == 0) {
+	    call calloc (out, SZ_LINE, TY_CHAR)
+	    call strcpy (Memc[in], Memc[out], SZ_LINE)
+	    if (section[1] != EOS) {
+		call strcat ("\\[", Memc[out], maxch)
+		call strcat (section, Memc[out], maxch)
+		call strcat ("]", Memc[out], maxch)
+	    }
+	    if (ikparams[1] != EOS) {
+		call strcat ("\\[", Memc[out], maxch)
+		call strcat (ikparams, Memc[out], maxch)
+		call strcat ("]", Memc[out], maxch)
+	    }
+
+	    if (index[1] == EOS && imx_sifmatch (Memc[out], expr)) {
+	        nimages = 1
+	        sif = imx_escape (Memc[out], index, extname, extver, ikparams, 
+		    section, expr, maxch)
+	    } else
+	        call calloc (sif, SZ_LINE, TY_CHAR)
+	    call mfree (out, TY_CHAR)
+	    return (sif)
+	}
+
+	# Format the output and set the number of images.
+	call calloc (listout, maxch, TY_CHAR)
+	iferr {
+	    while (fntgfnb (list, Memc[image], SZ_FNAME) != EOF) {
+		nimages = nimages + 1
+		if (nimages > 1) {
+		    call strcat (",", Memc[listout], maxch)
+		    len = len + 1
+		}
+		if ((len + strlen (Memc[image])) >= maxch) {
+		    maxch = maxch + SZ_LISTOUT
+		    call realloc (listout, maxch, TY_CHAR)
+		}
+
+		call strcat (Memc[image], Memc[listout], maxch)
+		len = len + strlen (Memc[image])
+
+#		if (section[1] != EOS) {
+#		    call strcat ("[", Memc[listout], maxch)
+#		    call strcat (section, Memc[listout], maxch)
+#		    call strcat ("]", Memc[listout], maxch)
+#		    len = len + strlen (section) + 2
+#		}
+	    }
+
+	    # Escape the output image specification in a form that is correct
+	    # for the filename template interface.
+
+	    out = imx_escape (Memc[listout], index, extname, extver, ikparams, 
+		section, expr, maxch)
+
+	} then {
+	    call fntclsb (list)
+	    call sfree (sp)
+	    call error (1, "Output list format is too long")
+	}
+	call fntclsb (list)
+	call sfree (sp)
+
+	return (out)
+end
+
+
+# IMX_FEXPAND -- Expand a template of files into a list of images names.
+
+pointer procedure imx_fexpand (input, expr, index, extname, extver, ikparams, 
+				section, nimages)
+
+char	input[ARB]			# List of ME file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of extension indexes
+char	extname[ARB]			# Patterns for extension names
+char 	extver[ARB]			# Range list of extension versions
+char	ikparams[ARB]			# Image kernel parameters
+char	section[ARB]			# Image section parameters
+int	nimages				# Number of output images
+
+pointer	sp, name, exp, lexp, nexp
+int	fd, ip, op, len, elen, nlines, nims, maxch, nchars, level
+bool	do_proc
+char	line[SZ_LINE], buf[SZ_LINE], ch
+
+define  output {buf[op]=$1;op=op+1}
+
+
+int	open(), getline(), strlen(), stridx()
+pointer	imx_imexpand()
+
+begin
+	iferr (fd = open (input, READ_ONLY, TEXT_FILE)) {
+	    call error (1, "Cannot open @file")
+	    return (NULL)
+	}
+
+	call smark (sp)
+	call salloc (name, SZ_PATHNAME, TY_CHAR)
+
+	maxch = SZ_FNT
+	call calloc (exp, maxch, TY_CHAR)
+	call aclrc (Memc[exp], maxch)
+
+#call eprintf (
+#  "fexpand: index='%s' name='%s' ver='%s' sec='%s' ik='%s' expr='%s'\n")
+#    call pargstr (index) ; call pargstr (extname) ; call pargstr (extver) ;
+#    call pargstr (section) ; call pargstr (ikparams) ; call pargstr (expr)
+
+	nlines = 0
+	nchars = 0
+	nimages = 0
+
+	while (getline (fd, line) > 0) {
+	    len = strlen (line)
+	    line[len] = EOS			# kill newline
+	    nlines = nlines + 1
+
+	    call aclrc (Memc[name], SZ_PATHNAME)
+	    call sprintf (Memc[name], SZ_PATHNAME, "@%s")
+		call pargstr (line)
+
+	    lexp = 0
+	    do_proc = (index[1]!=EOS || section[1]!=EOS || 
+		       expr[1]!=EOS || extname[1]!=EOS)
+
+	    if (input[1] == '@' || do_proc) {
+
+		# We're either being asked to expand what is presumably a
+		# image name in the form of an @@file input, or else we've
+		# added image sections, expressions, etc where the correct
+		# output specification is the expanded image name.
+
+	        lexp = imx_imexpand (Memc[name], expr, index, extname, extver,
+			ikparams, section, nims)
+
+	        elen = 0
+	        if (lexp != NULL && Memc[lexp] != EOS)
+		    elen = strlen (Memc[lexp])
+
+		# Reallocate space is the output name if needed.
+	        #if ((nchars + elen) >= (maxch - SZ_FNAME)) {
+	        if ((nchars + elen) >= maxch) {
+		    call calloc (nexp, maxch + SZ_FNT, TY_CHAR)
+		    call amovc (Memc[exp], Memc[nexp], maxch)
+		    call mfree (exp, TY_CHAR)
+		    maxch = maxch + SZ_FNT
+		    exp = nexp
+	        }
+
+		# Create a comma-delimited list.
+	        if (nlines > 1) 
+		    call strcat (",", Memc[exp], maxch)
+	        if (lexp != NULL && Memc[lexp] != EOS) {
+	            call strcat (Memc[lexp], Memc[exp], maxch)
+	            nchars = nchars + elen + 1
+	        }
+	        nimages = nimages + nims
+	    } else {
+	        if (nlines > 1) {
+		    call strcat (",", Memc[exp], maxch)
+	            nchars = nchars + 1
+		}
+		if (stridx ('[', line) != 0) {
+		    call aclrc (buf, SZ_LINE)
+		    op = 1
+		    for (ip=1; line[ip] != EOS; ip=ip+1) {
+			if (line[ip] == '[') {
+			    output ('%')
+			    output ('%')
+			    output (CH_DELIM)
+
+                    	    level = 0
+                    	    for (;  line[ip] != EOS;  ip=ip+1) {
+                        	ch = line[ip]
+                        	if (ch == ',') {                # ,
+                            	    if (level <= 0)
+                                	break                   # exit loop
+                            	    else {
+                                	output ('\\')
+                                	output (ch)
+                            	    }
+                        	} else if (ch == '[') {         # [
+                            	    output ('\\')
+                            	    output (ch)
+                            	    level = level + 1
+                        	} else if (ch == ']') {         # ]
+                            	    output (ch)
+                            	    level = level - 1
+                        	} else if (ch == '*') {         # *
+                            	    output ('\\')
+                            	    output (ch)
+                        	} else                          # normal chars
+                            	    output (ch)
+                    	    }
+                    	    output ('%')
+                    	    ip = ip - 1
+
+			    break
+			}
+			buf[op] = line[ip]
+			op = op + 1
+		    }
+	            call strcat (buf, Memc[exp], maxch)
+	            nchars = nchars + strlen (buf)
+
+		} else {
+	            call strcat (line, Memc[exp], maxch)
+	            nchars = nchars + strlen (line)
+		}
+
+	        nchars = nchars + len + 1
+	        nimages = nimages + 1
+
+		# Reallocate space is the output name if needed.
+
+	        if ((nchars + SZ_LINE) >= maxch) {
+		    call calloc (nexp, maxch + SZ_FNT, TY_CHAR)
+		    call amovc (Memc[exp], Memc[nexp], maxch)
+		    call mfree (exp, TY_CHAR)
+		    maxch = maxch + SZ_FNT
+		    exp = nexp
+	        }
+	    }
+	    call mfree (lexp, TY_CHAR)
+	}
+
+	call close (fd)			# clean up
+	call sfree (sp)
+
+	return (exp)
+end
+
+
+# IMX_TEXPAND -- Expand a template of tables into a list of images.
+
+pointer procedure imx_texpand (input, type, expr, index, fmt, nimages)
+
+char	input[ARB]			# Input table name
+int	type				# Table type
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of table rows
+char	fmt[ARB]			# Requested file format
+int	nimages				# Number of output images
+
+char	fname[SZ_PATHNAME]		# File name to open
+char	ofname[SZ_PATHNAME]
+pointer	sp, exp, nodename
+int	ip, vfd, status, delim
+
+pointer imx_votable(), imx_table()
+int	vfnopen(), vfnmapu(), strncmp(), ki_gnode()
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_PATHNAME, TY_CHAR)
+
+	exp = NULL			# initialize values
+	nimages = 0
+
+	# Get the base filename without the '@' prefix.
+	if (input[1] == '@')
+	    call strcpy (input[2], fname, SZ_PATHNAME)
+	else
+	    call strcpy (input, fname, SZ_PATHNAME)
+
+        # Map input VFN to OSFN.
+        ip = 1
+        if (strncmp (fname, "http://", 7) == 0) {
+            call strcpy (fname, ofname, SZ_PATHNAME)
+        } else {
+            vfd = vfnopen (fname, READ_ONLY)
+            status = vfnmapu (vfd, ofname, SZ_PATHNAME)
+            call vfnclose (vfd, VFN_NOUPDATE)
+
+            # If the file resides on the local node strip the node name,
+            # returning a legal host system filename as the result.
+            if (ki_gnode (ofname, Memc[nodename], delim) == 0)
+                ip = delim + 1
+        }
+
+
+	# Now process the file.  For a VOTable we parse the file and
+	# extract the acref columns as cached image names, for ascii
+	# tables we read the URLs directly but likewise returned the
+	# cache name.
+
+	if (type == IMT_TABLE)
+	    exp = imx_table (ofname[ip], index, nimages)
+	else if (type == IMT_VOTABLE)
+	    exp = imx_votable (ofname[ip], expr, index, fmt, nimages)
+
+	call sfree (sp)
+	return (exp)
+end
+
+
+# IMX_DEXPAND -- Expand a directory into a list of images.
+
+pointer procedure imx_dexpand (input, expr, index, extname, extver, ikparams, 
+    sec, nimages)
+
+char	input[ARB]			# List of MEF file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Index range
+char	extname[ARB]			# Extension name
+char	extver[ARB]			# Extension version
+char	ikparams[ARB]			# IKI parameters
+char	sec[ARB]			# Image section
+int	nimages				# Number of output images
+
+pointer	sp, exp, nodename, imname, listout
+int     dir, len, llen, nim, ip, delim, vfd, status, maxlen
+char    dirname[SZ_PATHNAME], ofname[SZ_PATHNAME], pdir[SZ_PATHNAME]
+char    fpath[SZ_PATHNAME], fname[SZ_PATHNAME]
+		
+pointer imx_imexpand ()
+int	vfnopen(), vfnmapu(), ki_gnode(), imx_filetype()
+int     strlen(), diropen(), isdirectory(), getline()
+
+begin
+	call smark (sp)
+	call salloc (nodename, SZ_PATHNAME, TY_CHAR)
+
+	# Get the base filename without the '@' prefix.
+	if (input[1] == '@') {
+	    if (input[2] == '@')
+	        call strcpy (input[3], dirname, SZ_PATHNAME)
+	    else
+	        call strcpy (input[2], dirname, SZ_PATHNAME)
+	} else
+	    call strcpy (input, dirname, SZ_PATHNAME)
+
+	# Remove trailing '/' or '$' from dir
+	len = strlen (dirname)		
+	if (dirname[len] == '/')
+	    dirname[len] = EOS
+
+        # Map input VFN to OSFN.
+        ip = 1
+        vfd = vfnopen (dirname, READ_ONLY)
+        status = vfnmapu (vfd, ofname, SZ_PATHNAME)
+        call vfnclose (vfd, VFN_NOUPDATE)
+
+        # If the file resides on the local node strip the node name,
+        # returning a legal host system filename as the result.
+        if (ki_gnode (ofname, Memc[nodename], delim) == 0)
+            ip = delim + 1
+
+	call sfree (sp)
+
+        # Otherwise, read through the directory and remove the contents.
+        dir = diropen (ofname, SKIP_HIDDEN_FILES)
+
+	maxlen = SZ_LISTOUT
+	call calloc (listout, SZ_LISTOUT, TY_CHAR)
+	llen = 0
+        while (getline (dir, fname) != EOF) {
+            len = strlen (fname)
+            fname[len] = '\0'
+            
+            len = strlen (ofname)
+	    if (ofname[len] == '/' || ofname[len] == '$')
+	        call sprintf (fpath, SZ_PATHNAME, "%s%s")
+	    else
+	        call sprintf (fpath, SZ_PATHNAME, "%s/%s")
+		    call pargstr (dirname)
+		    call pargstr (fname)
+
+	    llen = llen + strlen (fpath)
+
+            # We only test plain files, skip directories.
+	    if (isdirectory (fpath, pdir, SZ_PATHNAME) > 0)
+		next
+
+	    if (imx_filetype (fpath) == IMT_IMAGE) {
+
+		if (input[2] == '@')
+		    imname = imx_imexpand (fpath, expr, index, extname, extver, 
+		        ikparams, sec, nim)
+		else {
+		    call calloc (imname, SZ_PATHNAME, TY_CHAR)
+		    call strcpy (fpath, Memc[imname], SZ_PATHNAME)
+		}
+
+		if (imname != NULL && Memc[imname] != EOS) {
+		    nimages = nimages + 1
+
+		    if (nimages > 1) {
+		        call strcat (",", Memc[listout], maxlen)
+		        llen = llen + 1
+		    }
+		    if ((llen + strlen (Memc[imname])) >= maxlen) {
+		        maxlen = maxlen + SZ_LISTOUT
+		        call realloc (listout, maxlen, TY_CHAR)
+		    }
+
+		    call strcat (Memc[imname], Memc[listout], maxlen)
+		    llen = llen + strlen (Memc[imname])
+
+		    if (sec[1] != EOS) {
+		        call strcat ("[", Memc[listout], maxlen)
+		        call strcat (sec, Memc[listout], maxlen)
+		        call strcat ("]", Memc[listout], maxlen)
+		        llen = llen + strlen (sec) + 2
+		    }
+
+		    if (imname != NULL)
+		        call mfree (imname, TY_CHAR)
+		}
+	    }
+        }
+
+	return (listout)
+end
+
+
+# IMX_FETCH -- Fetch the urls from the list.
+
+procedure imx_fetch (urls, istemp)
+
+char	urls[ARB]				#I file of URLS to download
+bool	istemp					#i is input file temporary?
+
+char	osfn[SZ_PATHNAME]
+char	url_osfn[SZ_PATHNAME]
+
+int	n, envgets()
+char	nthreads[SZ_FNAME]
+
+begin
+	# Get the host pathname of the cache directory.
+	call fmapfn ("cache$", osfn, SZ_PATHNAME)
+	call strupk (osfn, osfn, SZ_PATHNAME)
+
+	call fmapfn (urls, url_osfn, SZ_PATHNAME)
+	call strupk (url_osfn, url_osfn, SZ_PATHNAME)
+
+	n = envgets ("vo_nthreads", nthreads, SZ_FNAME)
+
+	# voget -B -C -D cache$ -b url -N <N> [-t] <infile>
+	if (istemp) {
+	    call vx_voget (10, "-B", "-C", "-D", osfn, "-b", "url", 
+	        "-N", nthreads, "-t", url_osfn)
+	} else {
+	    call vx_voget (10, "-B", "-C", "-D", osfn, "-b", "url", 
+	        "-N", nthreads, "-B", url_osfn)
+	}
+end
+
+
+# IMX_VOTABLE -- Read a VOTable, extracting the column of access references
+# as the image list.
+
+pointer procedure imx_votable (input, expr, index, fmt, nimages)
+
+char	input[ARB]			# List of ME file names
+char	expr[ARB]			# Filtering expression
+char	index[ARB]			# Range list of table rows
+char	fmt[ARB]			# Requested file format
+int	nimages				# Number of output images
+
+pointer	vot, exp, ranges
+int	nranges, tfd
+char	tfile[SZ_PATHNAME]
+
+int	open()
+int	imx_decode_ranges()
+pointer	imx_votselect(), votinit()
+bool	envgetb()
+
+begin
+	# Create a temp file for the parsed access references.
+	call mktemp ("tmp$vot", tfile, SZ_PATHNAME)
+	iferr (tfd = open (tfile, NEW_FILE, TEXT_FILE)) {
+	    nimages = 0
+	    return (NULL)
+	}
+
+	# Expand the index string into a range structure.
+	if (index[1] != EOS) {
+	    call calloc (ranges, 3 * SZ_RANGE, TY_INT)
+            if (imx_decode_ranges (index, Memi[ranges], SZ_RANGE,
+                 nranges, YES) == ERR) {
+		    call eprintf ("error parsing range '%s'\n")
+		        call pargstr (index)
+	    }
+	} else
+	    ranges = NULL
+ 
+	# Initialize the VOT struct and parse the table.
+	vot = votinit (input)
+
+	# Select the column from the VOTable with the access reference.
+	exp = imx_votselect (vot, tfd, fmt, ranges, nimages)
+
+	call mfree (ranges, TY_INT)
+	call votclose (vot)			# close the files
+	call close (tfd)
+
+	# Close the temp file and pre-fetch the data if needed.
+	if (envgetb ("vo_prefetch"))
+	    call imx_fetch (tfile, true)
+
+	return (exp)
+end
+
+
+# IMX_VOTSELECT -- Select the access reference column.
+
+pointer procedure imx_votselect (vot, fd, fmt, ranges, nimages)
+
+pointer	vot					#i VOTable struct pointer
+int	fd					#i filename of selected rows
+char	fmt[ARB]				#i file format
+pointer	ranges					#i ranges struct pointer
+int	nimages					#o no. selected images
+
+pointer	exp
+int	col, len, clen, maxlen
+char 	acref_ucd[SZ_FNAME], imfmt[SZ_FNAME], ucd_col[SZ_FNAME]
+char	acref[SZ_LINE], ucd[SZ_FNAME], buf[SZ_LINE], cfname[SZ_PATHNAME]
+int	i, rownum, field, acref_col, acfmt_col
+
+int	strcmp(), strsearch(), strlen(), vx_getNext()
+bool	imx_in_range()
+
+begin
+	# Figure out which table column we want.  Note that we assume there
+	# is only one <RESOURCE> element.  The caller may pass in a specific
+	# column to be used, otherwise look for for the named UCD.
+
+	col = 0						# FIXME
+	call aclrc (ucd_col, SZ_FNAME) 			# FIXME
+	call strcpy ("fits", imfmt, SZ_FNAME) 		# FIXME
+
+	call aclrc (acref_ucd, SZ_FNAME)
+	if (col > 0) {
+	    acref_col = col
+	} else {
+	    if (ucd_col[1] != EOS)
+		call strcpy (ucd_col, acref_ucd, SZ_FNAME)
+	    else
+		call strcpy (DEF_ACREF_UCD, acref_ucd, SZ_FNAME)
+
+	    # Find the access reference column number.
+            i = 0
+            for (field=VOT_FIELD(vot); field > 0; field=vx_getNext (field)) {
+		call aclrc (ucd, SZ_FNAME)
+                call vx_getAttr (field, "ucd", ucd, SZ_FNAME)
+		if (strcmp (ucd, acref_ucd) == 0) {
+		    acref_col = i
+		} else if (strcmp (ucd, DEF_FORMAT_UCD) == 0)
+		    acfmt_col = i
+	        i = i + 1
+	    }
+	}
+
+	maxlen = SZ_BUF
+	call calloc (exp, maxlen, TY_CHAR)
+
+	# Download the files.
+	for (i=0; i < VOT_NROWS(vot); i=i+1) {
+	    call vx_getTableCell (VOT_TDATA(vot), i, acfmt_col, imfmt, SZ_FNAME)
+
+	    if (fmt[1] == EOS || (fmt[1] != EOS && strsearch(imfmt, fmt) > 0)) {
+	        call vx_getTableCell (VOT_TDATA(vot), i, acref_col, 
+		    acref, SZ_LINE)
+
+	        # Do the row selection based on the index string.
+		rownum = i + 1
+	        if (ranges != NULL && ! imx_in_range (Memi[ranges], rownum))
+		    next
+
+	        # Generate a unique cache filename based on the URL.
+	        call fcname ("cache$", acref, "url", cfname, SZ_PATHNAME)
+
+	        # Append the cache name to the output string. Reallocate the
+	        # string pointer if needed.
+	        clen = strlen (cfname)
+	        if ((len + clen) >= maxlen) {
+		    maxlen = maxlen + SZ_BUF
+		    call realloc (exp, maxlen, TY_CHAR)
+	        }
+	        len = len + clen
+
+	        if (nimages == 0) {
+		    call strcpy (cfname, Memc[exp], maxlen)
+	        } else {
+		    call strcat (",", Memc[exp], maxlen)
+	            call strcat (cfname, Memc[exp], maxlen)
+	        }
+	        call aclrc (buf, SZ_LINE)
+
+		# Write the URL to the download file.
+		call fprintf (fd, "%s\n")
+		    call pargstr (acref)
+
+		nimages = nimages + 1
+	    }
+	}
+
+	return (exp)
+end
+
+
+# IMX_TABLE -- Read an ASCII text table of URLs and create the list
+# of files to process.  We apply the list index to do row selection
+# and return a list of cached filenames.
+
+pointer procedure imx_table (input, index, nimages)
+
+char	input[ARB]			# List of ME file names
+char	index[ARB]			# Range list of table rows
+int	nimages				# Number of output images
+
+pointer	exp, ranges
+int	rownum, nranges, fd, len, clen, maxlen
+char	buf[SZ_LINE], cfname[SZ_PATHNAME]
+
+int	open(), getline(), strlen()
+int	imx_decode_ranges()
+bool	imx_in_range(), envgetb()
+
+begin
+	call aclrc (buf, SZ_LINE)
+	iferr (fd = open (input, READ_ONLY, TEXT_FILE))
+	    call syserr (SYS_FOPEN)
+
+	maxlen = SZ_BUF
+	call calloc (exp, maxlen, TY_CHAR)
+
+	call calloc (ranges, 3 * SZ_RANGE, TY_INT)
+	if (index[1] != EOS) {
+            if (imx_decode_ranges (index, Memi[ranges], SZ_RANGE,
+                 nranges, YES) == ERR) {
+		    call eprintf ("error parsing range '%s'\n")
+		        call pargstr (index)
+	    }
+	}
+ 
+	len = 0
+	nimages = 0
+	rownum = 0
+	while (getline (fd, buf) != EOF) {
+
+	    # Skip comments and blank lines.
+	    if (buf[1] == '\n' || buf[1] == '#')
+		next
+	    else
+		rownum = rownum + 1
+
+	    # Do the row selection based on the index string.
+	    if (index[1] != EOS && ! imx_in_range (Memi[ranges], rownum))
+		next
+
+	    # Generate a unique cache filename based on the URL.
+	    call fcname ("cache$", buf, "url", cfname, SZ_PATHNAME)
+
+	    # Append the cache name to the output string. Reallocate the
+	    # string pointer if needed.
+	    clen = strlen (cfname)
+	    if ((len + clen) >= maxlen) {
+		maxlen = maxlen + SZ_BUF
+		call realloc (exp, maxlen, TY_CHAR)
+	    }
+	    len = len + clen
+
+	    if (nimages == 0) {
+		call strcpy (cfname, Memc[exp], maxlen)
+	    } else {
+		call strcat (",", Memc[exp], maxlen)
+	        call strcat (cfname, Memc[exp], maxlen)
+	    }
+	    call aclrc (buf, SZ_LINE)
+
+	    nimages = nimages + 1
+	}
+
+	call mfree (ranges, TY_INT)
+	call close (fd)
+
+	if (envgetb ("vo_prefetch"))
+	    call imx_fetch (input, false)
+
+	return (exp)
+end
+
+
+# IMX_EXTNS -- Expand a template of ME files into a list of image extensions.
+
+int procedure imx_extns (files, exttype, index, extname, extver, 
+		lindex, lname, lver, ikparams, section, expr, err)
+
+char	files[ARB]		#I List of ME files
+char	exttype[ARB]		#I Extension type string
+char	index[ARB]		#I Range list of extension indexes
+char	extname[ARB]		#I Patterns for extension names
+char	extver[ARB]		#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+char	expr[ARB]		#I Selection expression
+char	ikparams[ARB]		#I Image kernel parameters
+char	section[ARB]		#I Image section parameters
+int	err			#I Print errors?
+int	list			#O Image list
+
+int	i, fd, create
+pointer	sp, temp, fname, imname, sec, rindex, rextver, ikp, str
+int	fntopnb(), fntgfnb()
+int	imx_decode_ranges(), nowhite(), open()
+errchk	open, imx_extn, delete
+
+begin
+	call smark (sp)
+	call salloc (temp, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (sec, SZ_FNAME, TY_CHAR)
+	call salloc (ikp, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Expand parameters.
+	list = fntopnb (files, NO)
+	call salloc (rindex, 3*SZ_RANGE, TY_INT)
+	if (imx_decode_ranges (index, Memi[rindex], SZ_RANGE, i, create) == ERR)
+	    call error (1, "Bad index range list")
+
+	rextver = NULL
+	if (nowhite (extver, Memc[str], SZ_LINE) > 0) {
+	    call salloc (rextver, 3*SZ_RANGE, TY_INT)
+	    if (imx_decode_ranges (Memc[str], Memi[rextver], SZ_RANGE, 
+		i, create) == ERR)
+		    call error (1, "Bad extension version range list")
+	}
+
+	call aclrc (Memc[ikp], SZ_LINE)
+	i = nowhite (ikparams, Memc[ikp], SZ_LINE)
+
+	# Expand ME files into list of image extensions in a temp file.
+	call mktemp ("@tmp$iraf", Memc[temp], SZ_FNAME)
+	fd = open (Memc[temp+1], NEW_FILE, TEXT_FILE)
+	while (fntgfnb (list, Memc[fname], SZ_FNAME) != EOF) {
+	    call imgimage (Memc[fname], Memc[imname], SZ_FNAME)
+	    call imgsection (Memc[fname], Memc[sec], SZ_FNAME)
+
+	    call imx_extn (fd, Memc[imname], exttype, expr, rindex, extname, 
+		rextver, lindex, lname, lver, Memc[ikp], section, 
+		create, err)
+	}
+	call fntclsb (list)
+	call close (fd)
+
+	# Return list.
+	list = fntopnb (Memc[temp], NO)
+	call delete (Memc[temp+1])
+	call sfree (sp)
+
+	return (list)
+end
+
+
+# IMX_EXTN -- Expand a single ME file into a list of image extensions.
+# The image extensions are written to the input file descriptor.
+
+procedure imx_extn (fd, fname, exttype, expr, index, extname, extver, lindex, 
+		lname, lver, ikparams, section, create, err)
+
+int	fd			#I File descriptor for list 
+char	fname[SZ_FNAME]		#I File image name (without kernel or image sec)
+char	exttype[SZ_FNAME]	#I File extension type
+char	expr[ARB]		#I Selection expression
+pointer	index			#I Range list of extension indexes
+char	extname[ARB]		#I Pattern for extension names
+pointer	extver			#I Range list of extension versions
+int	lindex			#I List index number?
+int	lname			#I List extension name?
+int	lver			#I List extension version?
+char	ikparams[ARB]		#I Image kernel parameters
+char	section[ARB]		#I Image section
+int	create			#I Create names from index range?
+int	err			#I Print errors?
+
+pointer	sp, image, name, type, str, im
+int	i, j, ver
+
+pointer	immap()
+int	imx_get_next_number(), errcode(), imgeti(), stridxs(), strcmp()
+bool	imx_in_range(), imx_extmatch(), imx_matchexpr(), imx_sifmatch()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (type, SZ_FNAME, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	i = -1
+	while (imx_get_next_number (Memi[index], i) != EOF) {
+	    j = stridxs ("[", fname)
+	    if (j > 0) {
+		if (i > 0)
+		    break
+		call strcpy (fname, Memc[image], SZ_FNAME)
+	    } else {
+		call sprintf (Memc[image], SZ_FNAME, "%s[%d]")
+		    call pargstr (fname)
+		    call pargi (i)
+	    }
+
+	    if (section[1] != EOS) {
+		call strcat ("[", Memc[image], SZ_FNAME)
+		call strcat (section, Memc[image], SZ_FNAME)
+		call strcat ("]", Memc[image], SZ_FNAME)
+	    }
+
+	    # We know the extension doesn't exist, generate the name.
+	    if (create == YES) {
+		call fprintf (fd, "%s")
+		    call pargstr (Memc[image])
+		if (section[1] != EOS) {
+		    call fprintf (fd, "[%s]")
+		        call pargstr (section)
+		}
+		call fprintf (fd, "\n")
+		next
+	    }
+
+
+	    iferr (im = immap (Memc[image], READ_ONLY, 0)) {
+		switch (errcode()) {
+		case SYS_FXFRFEOF:
+		    if (i == 1) {
+			if (extname[1] == EOS && imx_sifmatch (fname, expr)) {
+	    		    call fprintf (fd, "%s\n")
+			        call pargstr (fname)
+		 	    next
+			} else
+			    break
+		    }
+		    break
+		case SYS_IKIEXTN:
+		    next
+		case SYS_IKIOPEN:
+		    switch (i) {
+		    case 0:
+			next
+		    case 1:
+			if (err == YES)
+			    call erract (EA_WARN)
+			break
+		    default:
+			break
+		    }
+		default:
+		    call erract (EA_ERROR)
+		}
+	    }
+
+
+	    # Check the extension type.  [NOT USED]
+	    if (exttype[1] != EOS) {
+		iferr (call imgstr (im, "xtension", Memc[type], SZ_FNAME))
+		    Memc[type] = EOS
+		if (Memc[type] != EOS && strcmp (Memc[type], exttype) != 0) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+#call eprintf("imx_extn: name='%s' ver='%s' expr='%s' sec='%s' iki='%s'\n")
+#  call pargstr (extname) ; call pargstr (Memc[extver]) ;
+#  call pargstr (expr) ; call pargstr (section) ;
+#  call pargstr (ikparams) ;
+
+	    # Check the extension name.
+	    if (extname[1] != EOS) {
+		iferr (call imgstr (im, "extname", Memc[name], SZ_FNAME))
+		    Memc[name] = EOS
+		if (!imx_extmatch (Memc[name], extname)) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+	    # Check the extension version.
+	    if (extver != NULL) {
+		iferr (ver = imgeti (im, "extver")) {
+		    call imunmap (im)
+		    next
+		}
+		if (!imx_in_range (Memi[extver], ver)) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+	    # Check the selection expression.
+	    if (expr[1] != EOS) {
+		if (!imx_matchexpr (im, expr)) {
+		    call imunmap (im)
+		    next
+		}
+	    }
+
+
+	    # Set the extension name and version.
+	    if (lname == YES) {
+		iferr (call imgstr (im, "extname", Memc[name], SZ_LINE))
+		    Memc[name] = EOS
+	    } else
+		Memc[name] = EOS
+	    if (lver == YES) {
+		iferr (ver = imgeti (im, "extver"))
+		    ver = INDEFI
+	    } else
+		ver = INDEFI
+
+	    # Write the image name.
+	    call fprintf (fd, fname)
+	    if (j == 0) {
+		if (lindex == YES || (Memc[name] == EOS && IS_INDEFI(ver))) {
+		    call fprintf (fd, "[%d]")
+			call pargi (i)
+		}
+		if (Memc[name] != EOS) {
+		    call fprintf (fd, "[%s")
+			call pargstr (Memc[name])
+		    if (!IS_INDEFI(ver)) {
+			call fprintf (fd, ",%d")
+			    call pargi (ver)
+		    }
+		    if (ikparams[1] != EOS) {
+			call fprintf (fd, ",%s")
+			    call pargstr (ikparams)
+		    }
+		    call fprintf (fd, "]")
+		} else if (!IS_INDEFI(ver)) {
+		    call fprintf (fd, "[extver=%d")
+			call pargi (ver)
+		    if (ikparams[1] != EOS) {
+			call fprintf (fd, ",%s")
+			    call pargstr (ikparams)
+		    }
+		    call fprintf (fd, "]")
+		} else if (ikparams[1] != EOS) {
+		    call fprintf (fd, "[%s]%%")
+			call pargstr (ikparams)
+		}
+	    }
+	    if (section[1] != EOS) {
+	        call fprintf (fd, "[%s]")
+		    call pargstr (section)
+	    }
+	    call fprintf (fd, "\n")
+		
+	    call imunmap (im)
+	}
+
+	call sfree (sp)
+end
+
+
+# IMX_DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by EOLIST.
+
+int procedure imx_decode_ranges (range_string, ranges, max_ranges, 
+		nvalues, create)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+int	create			# generate range string?
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	create = NO
+	if (range_string[1] == '+') {
+	    ip = 2
+	    create = YES
+	} else
+	    ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all nonnegative integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = EOLIST
+	    	    nvalues = MAX_INT
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = EOLIST
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		    if (step == 0)
+			return (ERR)
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# IMX_GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure imx_get_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != EOLIST;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (step == 0)
+		call error (1, "Step size of zero in range list")
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# IMX_EXTMATCH -- Match extname against a comma-delimited list of patterns.
+
+bool procedure imx_extmatch (extname, patterns)
+
+char	extname[ARB]		#I Extension name to match
+char	patterns[ARB]		#I Comma-delimited list of patterns
+bool	stat			#O Match?
+
+int	i, j, k, sz_pat, strlen(), patmake(), patmatch(), nowhite()
+pointer	sp, patstr, patbuf
+
+begin
+	stat = false
+
+	sz_pat = strlen (patterns)
+	if (sz_pat == 0)
+	    return (stat)
+	sz_pat = sz_pat + SZ_LINE
+
+	call smark (sp)
+	call salloc (patstr, sz_pat, TY_CHAR)
+	call salloc (patbuf, sz_pat, TY_CHAR)
+
+	i = nowhite (patterns, Memc[patstr], sz_pat)
+	if (i == 0)
+	    stat = true
+	else if (i == 1 && Memc[patstr] == '*')
+	    stat = true
+	else {
+	    i = 1
+	    for (j=i;; j=j+1) {
+		if (patterns[j] != ',' && patterns[j] != EOS)
+		    next
+		if (j - i > 0) {
+		    if (j-i == 1 && patterns[i] == '*') {
+			stat = true
+			break
+		    }
+		    call strcpy (patterns[i], Memc[patstr+1], j-i)
+		    Memc[patstr] = '^'
+		    Memc[patstr+j-i+1] = '$'
+		    Memc[patstr+j-i+2] = EOS
+		    k = patmake (Memc[patstr], Memc[patbuf], sz_pat)
+		    if (patmatch (extname, Memc[patbuf]) > 0) {
+			stat = true
+			break
+		    }
+		}
+		if (patterns[j] == EOS)
+		    break
+		i = j + 1
+	    }
+	}
+
+	call sfree (sp)
+	return (stat)
+end
+
+
+# IMX_IN_RANGE -- Test number to see if it is in range.
+# If the number is INDEFI then it is mapped to the maximum integer.
+
+bool procedure imx_in_range (ranges, number)
+
+int     ranges[ARB]             # Range array
+int     number                  # Number to be tested against ranges
+
+int     ip, first, last, step, num
+
+begin
+        if (IS_INDEFI (number))
+            num = MAX_INT
+        else
+            num = number
+
+        for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+            first = min (ranges[ip], ranges[ip+1])
+            last = max (ranges[ip], ranges[ip+1])
+            step = ranges[ip+2]
+            if (num >= first && num <= last)
+                if (mod (num - first, step) == 0)
+                    return (true)
+        }
+
+        return (false)
+end