Fossil

#!/bin/sh
# Copyright (c) 2006-2011 WorkWare Systems http://www.workware.net.au/
# All rights reserved
# vim:se syntax=tcl:
# \
dir=`dirname "$0"`; exec "`$dir/find-tclsh`" "$0" "$@"

set autosetup(version) 0.6.2

# Can be set to 1 to debug early-init problems
set autosetup(debug) 0

##################################################################

	exit 0
}

# @opt-bool option ...
#
# Check each of the named, boolean options and return 1 if any of them have
# been set by the user.
#
proc opt-bool {args} {
	option-check-names {*}$args
	opt_bool ::useropts {*}$args
}

# @opt-val option-list ?default=""?
#
# Returns a list containing all the values given for the non-boolean options in 'option-list'.
# There will be one entry in the list for each option given by the user, including if the
# same option was used multiple times.
# If only a single value is required, use something like:
#
## lindex [opt-val $names] end
#
# If no options were set, $default is returned (exactly, not as a list).
#
proc opt-val {names {default ""}} {
	option-check-names {*}$names
	join [opt_val ::useropts $names $default]
}

proc option-check-names {args} {
	foreach o $args {

#
# Undocumented options are also supported by omitting the "=> description.
# These options are not displayed with --help and can be useful for internal options or as aliases.
#
# For example, --disable-lfs is an alias for --disable=largefile:
#
## lfs=1 largefile=1 => "Disable large file support"
#
proc options {optlist} {
	# Allow options as a list or args
	options-add $optlist "Local Options:"

	if {$::autosetup(showhelp)} {
		options-show
		exit 0

		exec-with-stderr sh $::autosetup(dir)/config.sub $alias
	} else {
		return $alias
	}
}

# @define name ?value=1?
#
# Defines the named variable to the given value.
# These (name, value) pairs represent the results of the configuration check
# and are available to be checked, modified and substituted.
#
proc define {name {value 1}} {
	set ::define($name) $value
	#dputs "$name <= $value"

proc quote-argv {argv} {
	set args {}
	foreach arg $argv {
		lappend args [quote-if-needed $arg]
	}
	join $args
}

# @suffix suf list
#
# Takes a list and returns a new list with $suf appended
# to each element
#
## suffix .c {a b c} => {a.c b.c c.c}
#
proc suffix {suf list} {
	set result {}
	foreach p $list {
		lappend result $p$suf
	}
	return $result
}

# @prefix pre list
#
# Takes a list and returns a new list with $pre prepended
# to each element
#
## prefix jim- {a.c b.c} => {jim-a.c jim-b.c}
#
proc prefix {pre list} {
	set result {}
	foreach p $list {
		lappend result $pre$p
	}
	return $result
}

# @find-executable name
#
# Searches the path for an executable with the given name.
# Note that the name may include some parameters, e.g. "cc -mbig-endian",
# in which case the parameters are ignored.
# Returns 1 if found, or 0 if not.

# Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Simple getopt module

# Parse everything out of the argv list which looks like an option
# Knows about --enable-thing and --disable-thing as alternatives for --thing=0 or --thing=1
# Everything which doesn't look like an option, or is after --, is left unchanged
proc getopt {argvname} {
	upvar $argvname argv
	set nargv {}

	for {set i 0} {$i < [llength $argv]} {incr i} {
		set arg [lindex $argv $i]

		#dputs arg=$arg

		if {$arg eq "--"} {
			# End of options
			incr i
			lappend nargv {*}[lrange $argv $i end]
			break
		}

		if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} {
			lappend opts($name) $value
		} elseif {[regexp {^--(enable-|disable-)?([^=]*)$} $arg -> prefix name]} {
			if {$prefix eq "disable-"} {
				set value 0
			} else {
				set value 1
			}
			lappend opts($name) $value
		} else {
			lappend nargv $arg
		}
	}

	#puts "getopt: argv=[join $argv] => [join $nargv]"
	#parray opts

	set argv $nargv

	return [array get opts]
}

proc opt_val {optarrayname options {default {}}} {
	upvar $optarrayname opts

			user-notice "Warning: Initialising from the development version of autosetup"

			writefile configure "#!/bin/sh\nWRAPPER=\"\$0\" exec $::autosetup(dir)/autosetup \"\$@\"\n"
		} else {
			writefile configure \
{#!/bin/sh
dir="`dirname "$0"`/autosetup"
WRAPPER="$0" exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
}
		}
		catch {exec chmod 755 configure}
	}
	if {![file exists auto.def]} {
		puts "I don't see auto.def, so I will create a default one."
		writefile auto.def {# Initial auto.def created by 'autosetup --init'

use cc

# Add any user options here
options {
}

make-config-header config.h
make-template Makefile.in
}
	}
	if {![file exists Makefile.in]} {
		puts "Note: I don't see Makefile.in. You will probably need to create one."
	}

	# (Assume that Tcl does this for us)
	proc getenv {name args} {
		string map {\\ /} [env $name {*}$args]
	}
	# Jim uses system() for exec under mingw, so
	# we need to fetch the output ourselves
	proc exec-with-stderr {args} {
			set tmpfile auto[format %04x [rand 10000]].tmp
			set rc [catch [list exec {*}$args >$tmpfile 2>&1] result]
			set result [readfile $tmpfile]
			file delete $tmpfile
			return -code $rc $result
	}
} else {
	# Jim on unix is simple

#
proc cc-check-endian {} {
	cc-check-includes sys/types.h sys/param.h
	set rc 0
	msg-checking "Checking endian..."
	cc-with {-includes {sys/types.h sys/param.h}} {
		if {[cctest -code {
			#if !defined(BIG_ENDIAN) || !defined(BYTE_ORDER)
				#error unknown
			#elif BYTE_ORDER != BIG_ENDIAN
				#error little
			#endif
		}]} {
			define-feature big-endian
			msg-result "big"
			set rc 1
		} elseif {[cctest -code {
			#if !defined(LITTLE_ENDIAN) || !defined(BYTE_ORDER)
				#error unknown
			#elif BYTE_ORDER != LITTLE_ENDIAN
				#error big
			#endif
		}]} {
			define-feature little-endian
			msg-result "little"

		define SH_LDFLAGS -shared
		define SHOBJ_LDFLAGS -shared
	}
	*-*-cygwin {
		define SH_LDFLAGS -shared
		define SHOBJ_LDFLAGS -shared
	}
	*-*-solaris* {
		# XXX: These haven't been fully tested. 
		#define SH_LINKFLAGS -Wl,-export-dynamic
		define SH_CFLAGS -Kpic
		define SHOBJ_CFLAGS -Kpic
		define SHOBJ_LDFLAGS "-G"
	}
	*-*-hpux {
		# XXX: These haven't been tested
		define SH_LINKFLAGS -Wl,+s
		define SH_CFLAGS +z
		define SHOBJ_CFLAGS "+O3 +z"
		define SHOBJ_LDFLAGS -b
		define LD_LIBRARY_PATH SHLIB_PATH
	}
	* {
		# Generic Unix settings
		define SH_LINKFLAGS -rdynamic
		define SH_CFLAGS -fpic
		define SH_LDFLAGS -shared
		define SHOBJ_CFLAGS -fpic
		define SHOBJ_LDFLAGS "-shared -nostartfiles"
	}
}

##   return 0;
## }
#
# Any failures are recorded in 'config.log'
#
proc cctest {args} {
	set src conftest__.c
	set tmp conftest__

	# Easiest way to merge in the settings
	cc-with $args {
		array set opts [cc-get-settings]
	}

	if {[info exists opts(-sourcefile)]} {

		}
		default {
			autosetup-error "cctest called with unknown language: $opts(-lang)"
		}
	}

	if {!$opts(-link)} {
		set tmp conftest__.o
		lappend cmdline -c
	}
	lappend cmdline {*}$opts(-cflags)

	switch -glob -- [get-define host] {
		*-*-darwin* {
			# Don't generate .dSYM directories

# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# @synopsis:
#
# This module supports common system interrogation and options
# such as --host, --build, --prefix, and setting srcdir, builddir, and EXEXT.
#
# It also support the 'feature' naming convention, where searching
# for a feature such as sys/type.h defines HAVE_SYS_TYPES_H
#


module-options {
	host:host-alias =>		{a complete or partial cpu-vendor-opsys for the system where
							the application will run (defaults to the same value as --build)}
	build:build-alias =>	{a complete or partial cpu-vendor-opsys for the system
							where the application will be built (defaults to the
							result of running config.guess)}
	prefix:dir =>			{the target directory for the build (defaults to /usr/local)}

	# These (hidden) options are supported for autoconf/automake compatibility
	exec-prefix:
	bindir:
	sbindir:
	includedir:
	mandir:
	infodir:
	libexecdir:
	datadir:
	libdir:
	sysconfdir:
	sharedstatedir:
	localstatedir:

	maintainer-mode=0
	dependency-tracking=0
}

# Returns 1 if exists, or 0 if  not
#
proc check-feature {name code} {

# Each pattern of the form @define@ is replaced the the corresponding
# define, if it exists, or left unchanged if not.
# 
# The special value @srcdir@ is subsituted with the relative
# path to the source directory from the directory where the output
# file is created. Use @top_srcdir@ for the absolute path.
#
# Conditional sections may be specified as follows:
## @if name == value
## lines
## @else
## lines
## @endif
#
# Where 'name' is a defined variable name and @else is optional.
# If the expression does not match, all lines through '@endif' are ignored.
#
# The alternative forms may also be used:
## @if name
## @if name != value
#
# Where the first form is true if the variable is defined, but not empty or 0
#
# Currently these expressions can't be nested.
#
proc make-template {template {out {}}} {
	set infile [file join $::autosetup(srcdir) $template]

	if {![file exists $infile]} {
		user-error "Template $template is missing"
	}

	# Set up srcdir to be relative to the target dir
	define srcdir [relative-path [file join $::autosetup(srcdir) $outdir] $outdir]

	set mapping {}
	foreach {n v} [array get ::define] {
		lappend mapping @$n@ $v
	}
	set result {}
	foreach line [split [readfile $infile] \n] {
		if {[info exists cond]} {
			set l [string trimright $line]
			if {$l eq "@endif"} {
				unset cond
				continue
			}
			if {$l eq "@else"} {
				set cond [expr {!$cond}]
				continue
			}
			if {$cond} {
				lappend result $line
			}
			continue
		}
		if {[regexp {^@if\s+(\w+)(.*)} $line -> name expression]} {
			lassign $expression equal value
			set varval [get-define $name ""]
			if {$equal eq ""} {
				set cond [expr {$varval ni {"" 0}}]
			} else {
				set cond [expr {$varval eq $value}]
				if {$equal ne "=="} {
					set cond [expr {!$cond}]
				}
			}
			continue
		}
		lappend result $line
	}
	writefile $out [string map $mapping [join $result \n]]\n

	msg-result "Created [relative-path $out] from [relative-path $template]"
}

# build/host tuples and cross-compilation prefix
set build [opt-val build]
define build_alias $build

define target [get-define host]
define prefix $prefix
define builddir $autosetup(builddir)
define srcdir $autosetup(srcdir)
# Allow this to come from the environment
define top_srcdir [get-env top_srcdir [get-define srcdir]]

# autoconf supports all of these
define exec_prefix [opt-val exec-prefix [get-env exec-prefix \${prefix}]]
foreach {name defpath} {
	bindir \${exec_prefix}/bin
	sbindir \${exec_prefix}/sbin
	libexecdir \${exec_prefix}/libexec
	libdir \${exec_prefix}/lib
	datadir \${prefix}/share
	sysconfdir \${prefix}/etc
	sharedstatedir \${prefix}/com
	localstatedir \${prefix}/var

	infodir \${prefix}/share/info
	mandir \${prefix}/share/man
	includedir \${prefix}/include
} {
	define $name [opt-val $name [get-env $name $defpath]]
}

define SHELL [get-env SHELL [find-an-executable sh bash ksh]]

# Windows vs. non-Windows
switch -glob -- [get-define host] {
	*-*-ming* - *-*-cygwin {
		define-feature windows

#!/bin/sh
dir="`dirname "$0"`/autosetup"
WRAPPER="$0" exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"

/*
** This routine is called if a blob operation fails because we
** have run out of memory.
*/
static void blob_panic(void){
  static const char zErrMsg[] = "out of memory\n";
  fputs(zErrMsg, stderr);
  fossil_exit(1);
}

/*
** A reallocation function that assumes that aData came from malloc().
** This function attempts to resize the buffer of the blob to hold
** newSize bytes.  

** Show a timeline of all branches
*/
void brlist_page(void){
  Stmt q;
  int cnt;
  int showClosed = P("closed")!=0;
  int showAll = P("all")!=0;
  int colorTest = P("colortest")!=0;

  login_check_credentials();
  if( !g.okRead ){ login_needed(); return; }
  if( colorTest ){
    showClosed = 0;
    showAll = 1;
  }

  style_header(showClosed ? "Closed Branches" :
                  showAll ? "All Branches" : "Open Branches");
  style_submenu_element("Timeline", "Timeline", "brtimeline");
  if( showClosed ){
    style_submenu_element("All", "All", "brlist?all");
    style_submenu_element("Open","Open","brlist");
  }else if( showAll ){
    style_submenu_element("Closed", "Closed", "brlist?closed");
    style_submenu_element("Open","Open","brlist");
  }else{
    style_submenu_element("All", "All", "brlist?all");
    style_submenu_element("Closed","Closed","brlist?closed");
  }
  if( !colorTest ){
    style_submenu_element("Color-Test", "Color-Test", "brlist?colortest");
  }else{
    style_submenu_element("All", "All", "brlist?all");
  }
  login_anonymous_available();
  style_sidebox_begin("Nomenclature:", "33%");
  @ <ol>
  @ <li> An <div class="sideboxDescribed"><a href="brlist">
  @ open branch</a></div> is a branch that has one or
  @ more <a href="leaves">open leaves.</a>
  @ The presence of open leaves presumably means

  style_sidebox_end();

  prepareBranchQuery(&q, showAll, showClosed);
  cnt = 0;
  while( db_step(&q)==SQLITE_ROW ){
    const char *zBr = db_column_text(&q, 0);
    if( cnt==0 ){
      if( colorTest ){
        @ <h2>Default background colors for all branches:</h2>
      }else if( showAll ){
        @ <h2>All Branches:</h2>
      }else if( showClosed ){
        @ <h2>Closed Branches:</h2>
      }else{
        @ <h2>Open Branches:</h2>
      }
      @ <ul>
      cnt++;
    }
    if( colorTest ){
      const char *zColor = hash_color(zBr);
      @ <li><span style="background-color: %s(zColor)">
      @ %h(zBr) &rarr; %s(zColor)</span></li>
    }else if( g.okHistory ){
      @ <li><a href="%s(g.zTop)/timeline?r=%T(zBr)")>%h(zBr)</a></li>
    }else{
      @ <li><b>%h(zBr)</b></li>
    }
  }
  if( cnt ){
    @ </ul>
  }

  listen(listener,10);
  if( iPort>mnPort ){
    fossil_print("Listening for HTTP requests on TCP port %d\n", iPort);
    fflush(stdout);
  }
  if( zBrowser ){
    zBrowser = mprintf(zBrowser, iPort);
    if( system(zBrowser)<0 ){
      fossil_warning("cannot start browser: %s\n", zBrowser);
    }
  }
  while( 1 ){
    if( nchildren>MAX_PARALLEL ){
      /* Slow down if connections are arriving too fast */
      sleep( nchildren-MAX_PARALLEL );
    }
    delay.tv_sec = 60;
    delay.tv_usec = 0;
    FD_ZERO(&readfds);
    FD_SET( listener, &readfds);
    select( listener+1, &readfds, 0, 0, &delay);
    if( FD_ISSET(listener, &readfds) ){
      lenaddr = sizeof(inaddr);
      connection = accept(listener, (struct sockaddr*)&inaddr, &lenaddr);
      if( connection>=0 ){
        child = fork();
        if( child!=0 ){
          if( child>0 ) nchildren++;
          close(connection);
        }else{
          int nErr = 0, fd;
          close(0);
          fd = dup(connection);
          if( fd!=0 ) nErr++;
          close(1);
          fd = dup(connection);
          if( fd!=1 ) nErr++;
          if( !g.fHttpTrace && !g.fSqlTrace ){
            close(2);
            fd = dup(connection);
            if( fd!=2 ) nErr++;
          }
          close(connection);
          return nErr;
        }
      }
    }
    /* Bury dead children */
    while( waitpid(0, 0, WNOHANG)>0 ){
      nchildren--;
    }

    close(pin[1]);
    close(pout[0]);
    close(pout[1]);
    *pChildPid = 0;
    return 1;
  }
  if( *pChildPid==0 ){
    int fd;
    int nErr = 0;
    /* This is the child process */
    close(0);
    fd = dup(pout[0]);
    if( fd!=0 ) nErr++;
    close(pout[0]);
    close(pout[1]);
    close(1);
    fd = dup(pin[1]);
    if( fd!=1 ) nErr++;
    close(pin[0]);
    close(pin[1]);
    execl("/bin/sh", "/bin/sh", "-c", zCmd, (char*)0);
    return 1;
  }else{
    /* This is the parent process */
    close(pin[1]);

    }
    blob_reset(&delta);
 }
  db_finalize(&q);
}

/*
** Drop the indicated stash
*/
static void stash_drop(int stashid){
  db_multi_exec(
    "DELETE FROM stash WHERE stashid=%d;"
    "DELETE FROM stashfile WHERE stashid=%d;",
    stashid, stashid
  );

**  fossil stash goto ?STASHID?
**
**     Update to the baseline checkout for STASHID then apply the
**     changes of STASHID.  Keep STASHID so that it can be reused
**     This command is undoable.
**
**  fossil stash drop ?STASHID? ?--all?
**  fossil stash rm   ?STASHID? ?--all?
**
**     Forget everything about STASHID.  Forget the whole stash if the
**     --all flag is used.  Individual drops are undoable but --all is not.
**
**  fossil stash snapshot ?-m COMMENT? ?FILES...?
**
**     Save the current changes in the working tree as a new stash

        fossil_print("       ");
        comment_print(zCom, 7, 79);
      }
    }
    db_finalize(&q);
    if( n==0 ) fossil_print("empty stash\n");
  }else
  if( memcmp(zCmd, "drop", nCmd)==0 || memcmp(zCmd, "rm", nCmd)==0 ){
    int allFlag = find_option("all", 0, 0)!=0;
    if( g.argc>4 ) usage("stash apply STASHID");
    if( allFlag ){
      db_multi_exec("DELETE FROM stash; DELETE FROM stashfile;");
    }else{
      stashid = stash_get_id(g.argc==4 ? g.argv[3] : 0);
      undo_begin();

    case 3:  r = mn; g = h2, b = mx;  break;
    case 4:  r = h2; g = mn, b = mx;  break;
    default: r = mx; g = mn, b = h2;  break;
  }
  sqlite3_snprintf(8, zColor, "#%02x%02x%02x", r,g,b);
  return zColor;
}

/*
** COMMAND:  test-hash-color
**
** Usage: %fossil test-hash-color TAG ...
**
** Print out the color names associated with each tag.  Used for
** testing the hash_color() function.
*/
void test_hash_color(void){
  int i;
  for(i=2; i<g.argc; i++){
    fossil_print("%20s: %s\n", g.argv[i], hash_color(g.argv[i]));
  }
}

/*
** Output a timeline in the web format given a query.  The query
** should return these columns:
**
**    0.  rid
**    1.  UUID

<title>Check-in Checklist</title>

<h2><u>Always</u> run the following checklist prior to <u>every</u>
check-in or commit to the Fossil repository:</h2>

Before every check-in:

  0.   <b>fossil user default</b> &rarr; your username is correct.

  1.   <b>fossil diff</b> &rarr;
       <ol type="a">
       <li> No stray changes
       <li> All changes comply with the license
       <li> All inputs are scrubbed before use
       <li> No injection attacks via %s formats
       </ol>

  6.   No compiler warnings on the development machine.

  7.   The fossil executable that results from a build actually works.


<hr>
<h2>Commentary</h2>

Before you go ahead and push content back to the servers, make sure
that the username you are using by default matches your username
within the project. Also remember to enable the localauth setting
if you intend to make changes via a locally served web UI.

Item 1 is the most important step.  Consider using <b>gdiff</b>
instead of <b>diff</b> if you have a graphical differ configured.  Or,
pipe the output of "<b>fossil diff</b>" into "<b>open -f</b>" (on a mac) to
get the diff output in a separate text window for easier viewing.
Look carefully at every changed line in item 1.
Make sure that you are not about to commit unrelated changes.