diff options
Diffstat (limited to 'web/src')
96 files changed, 34228 insertions, 0 deletions
diff --git a/web/src/Makefile.am b/web/src/Makefile.am new file mode 100644 index 00000000..5e822d91 --- /dev/null +++ b/web/src/Makefile.am @@ -0,0 +1,22 @@ +# ======================================================================== +# Copyright 2006-2008 University of Washington +# +# 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 +# +# ======================================================================== + + +all: + cd @abs_top_srcdir@/web/src/cgi.tcl-1.10 && ./configure --prefix=@abs_top_srcdir@/web/lib + +install: + cd @abs_top_srcdir@/web/src/alpined.d && make install + cd @abs_top_srcdir@/web/src/cgi.tcl-1.10 && make install SCRIPTDIR=@abs_top_srcdir@/web/lib + cd @abs_top_srcdir@/web/lib && tclsh ./pkgcreate + if test -x pubcookie/wp_uidmapper ; then $(LN) -f pubcookie/wp_uidmapper @abs_top_srcdir@/web/bin ; fi + if test -x pubcookie/wp_tclsh ; then $(LN) -f pubcookie/wp_tclsh @abs_top_srcdir@/web/bin ; fi + if test -x pubcookie/wp_gssapi_proxy ; then $(LN) -f pubcookie/wp_gssapi_proxy @abs_top_srcdir@/web/bin ; fi diff --git a/web/src/Makefile.in b/web/src/Makefile.in new file mode 100644 index 00000000..b208cc32 --- /dev/null +++ b/web/src/Makefile.in @@ -0,0 +1,421 @@ +# Makefile.in generated by automake 1.11.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, +# Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# ======================================================================== +# Copyright 2006-2008 University of Washington +# +# 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 +# +# ======================================================================== +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = web/src +DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/acx_pthread.m4 \ + $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ + $(top_srcdir)/m4/lib-ld.m4 $(top_srcdir)/m4/lib-link.m4 \ + $(top_srcdir)/m4/lib-prefix.m4 $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/po.m4 \ + $(top_srcdir)/m4/progtest.m4 $(top_srcdir)/VERSION \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs +CONFIG_HEADER = $(top_builddir)/include/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +SOURCES = +DIST_SOURCES = +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_CFLAGS = @AM_CFLAGS@ +AM_LDFLAGS = @AM_LDFLAGS@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CP = @CP@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +C_CLIENT_CFLAGS = @C_CLIENT_CFLAGS@ +C_CLIENT_GCCOPTLEVEL = @C_CLIENT_GCCOPTLEVEL@ +C_CLIENT_LDFLAGS = @C_CLIENT_LDFLAGS@ +C_CLIENT_SPECIALS = @C_CLIENT_SPECIALS@ +C_CLIENT_TARGET = @C_CLIENT_TARGET@ +C_CLIENT_WITH_IPV6 = @C_CLIENT_WITH_IPV6@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +GMSGFMT = @GMSGFMT@ +GMSGFMT_015 = @GMSGFMT_015@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +INTLLIBS = @INTLLIBS@ +INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ +ISPELLPROG = @ISPELLPROG@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBICONV = @LIBICONV@ +LIBINTL = @LIBINTL@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN = @LN@ +LN_S = @LN_S@ +LTLIBICONV = @LTLIBICONV@ +LTLIBINTL = @LTLIBINTL@ +LTLIBOBJS = @LTLIBOBJS@ +MAINT = @MAINT@ +MAKE = @MAKE@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +MSGFMT = @MSGFMT@ +MSGFMT_015 = @MSGFMT_015@ +MSGMERGE = @MSGMERGE@ +NM = @NM@ +NMEDIT = @NMEDIT@ +NPA_PROG = @NPA_PROG@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +POSUB = @POSUB@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +PWPROG = @PWPROG@ +RANLIB = @RANLIB@ +REGEX_BUILD = @REGEX_BUILD@ +RM = @RM@ +SED = @SED@ +SENDMAIL = @SENDMAIL@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SPELLPROG = @SPELLPROG@ +STRIP = @STRIP@ +USE_NLS = @USE_NLS@ +VERSION = @VERSION@ +WEB_BINDIR = @WEB_BINDIR@ +WEB_BUILD = @WEB_BUILD@ +WEB_PUBCOOKIE_BUILD = @WEB_PUBCOOKIE_BUILD@ +WEB_PUBCOOKIE_LIB = @WEB_PUBCOOKIE_LIB@ +WEB_PUBCOOKIE_LINK = @WEB_PUBCOOKIE_LINK@ +XGETTEXT = @XGETTEXT@ +XGETTEXT_015 = @XGETTEXT_015@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +acx_pthread_config = @acx_pthread_config@ +alpine_interactive_spellcheck = @alpine_interactive_spellcheck@ +alpine_simple_spellcheck = @alpine_simple_spellcheck@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_ECHO = @lt_ECHO@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +all: all-am + +.SUFFIXES: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign web/src/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign web/src/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs +tags: TAGS +TAGS: + +ctags: CTAGS +CTAGS: + + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile +installdirs: +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-generic + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: all all-am check check-am clean clean-generic clean-libtool \ + distclean distclean-generic distclean-libtool distdir dvi \ + dvi-am html html-am info info-am install install-am \ + install-data install-data-am install-dvi install-dvi-am \ + install-exec install-exec-am install-html install-html-am \ + install-info install-info-am install-man install-pdf \ + install-pdf-am install-ps install-ps-am install-strip \ + installcheck installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am uninstall uninstall-am + + +all: + cd @abs_top_srcdir@/web/src/cgi.tcl-1.10 && ./configure --prefix=@abs_top_srcdir@/web/lib + +install: + cd @abs_top_srcdir@/web/src/alpined.d && make install + cd @abs_top_srcdir@/web/src/cgi.tcl-1.10 && make install SCRIPTDIR=@abs_top_srcdir@/web/lib + cd @abs_top_srcdir@/web/lib && tclsh ./pkgcreate + if test -x pubcookie/wp_uidmapper ; then $(LN) -f pubcookie/wp_uidmapper @abs_top_srcdir@/web/bin ; fi + if test -x pubcookie/wp_tclsh ; then $(LN) -f pubcookie/wp_tclsh @abs_top_srcdir@/web/bin ; fi + if test -x pubcookie/wp_gssapi_proxy ; then $(LN) -f pubcookie/wp_gssapi_proxy @abs_top_srcdir@/web/bin ; fi + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/web/src/alpined.d/Makefile.am b/web/src/alpined.d/Makefile.am new file mode 100644 index 00000000..9101e4fb --- /dev/null +++ b/web/src/alpined.d/Makefile.am @@ -0,0 +1,52 @@ +## Process this file with automake to produce Makefile.in +## Use aclocal -I m4; automake + +# ======================================================================== +# Copyright 2006 University of Washington +# +# 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 +# +# ======================================================================== + +# This is because alpined, libwpcomm and friends are +# not intended for system-wide consumption +locbindir = @abs_srcdir@/../../bin +loclibdir = @abs_srcdir@/../../lib + +locbin_PROGRAMS = alpined alpineldap + +alpined_SOURCES = alpined.c busy.c color.c imap.c ldap.c remote.c \ + signal.c debug.c status.c stubs.c \ + alpined.h color.h ldap.h + +alpineldap_SOURCES = alpineldap.c busy.c color.c imap.c ldap.c remote.c \ + signal.c debug.c status.c stubs.c \ + alpined.h color.h ldap.h + +LDADD = local.o \ + @top_srcdir@/pith/libpith.a \ + @top_srcdir@/pith/osdep/libpithosd.a \ + @top_srcdir@/pith/charconv/libpithcc.a \ + @top_srcdir@/c-client/c-client.a \ + $(WEB_PUBCOOKIE_LIB) + +loclib_LTLIBRARIES = libwpcomm.la + +libwpcomm_la_SOURCES = wpcomm.c + +libwpcomm_la_LDFLAGS = -rpath '$(loclibdir)' -version-info 1:0:0 + +AM_CPPFLAGS = -I@top_builddir@/include -I@top_srcdir@/include + +AM_LDFLAGS = `cat @top_srcdir@/c-client/LDFLAGS` + +CLEANFILES = local.c + +local.c: alpineldap.c color.c imap.c ldap.c remote.c signal.c \ + debug.c status.c stubs.c alpined.h color.h ldap.h + echo "char datestamp[]="\"`date`\"";" > local.c + echo "char hoststamp[]="\"`hostname`\"";" >> local.c diff --git a/web/src/alpined.d/Makefile.in b/web/src/alpined.d/Makefile.in new file mode 100644 index 00000000..644fd530 --- /dev/null +++ b/web/src/alpined.d/Makefile.in @@ -0,0 +1,695 @@ +# Makefile.in generated by automake 1.11.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, +# Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# ======================================================================== +# Copyright 2006 University of Washington +# +# 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 +# +# ======================================================================== + + +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +locbin_PROGRAMS = alpined$(EXEEXT) alpineldap$(EXEEXT) +subdir = web/src/alpined.d +DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/acx_pthread.m4 \ + $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ + $(top_srcdir)/m4/lib-ld.m4 $(top_srcdir)/m4/lib-link.m4 \ + $(top_srcdir)/m4/lib-prefix.m4 $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/po.m4 \ + $(top_srcdir)/m4/progtest.m4 $(top_srcdir)/VERSION \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs +CONFIG_HEADER = $(top_builddir)/include/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__installdirs = "$(DESTDIR)$(loclibdir)" "$(DESTDIR)$(locbindir)" +LTLIBRARIES = $(loclib_LTLIBRARIES) +libwpcomm_la_LIBADD = +am_libwpcomm_la_OBJECTS = wpcomm.lo +libwpcomm_la_OBJECTS = $(am_libwpcomm_la_OBJECTS) +libwpcomm_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(libwpcomm_la_LDFLAGS) $(LDFLAGS) -o $@ +PROGRAMS = $(locbin_PROGRAMS) +am_alpined_OBJECTS = alpined.$(OBJEXT) busy.$(OBJEXT) color.$(OBJEXT) \ + imap.$(OBJEXT) ldap.$(OBJEXT) remote.$(OBJEXT) \ + signal.$(OBJEXT) debug.$(OBJEXT) status.$(OBJEXT) \ + stubs.$(OBJEXT) +alpined_OBJECTS = $(am_alpined_OBJECTS) +alpined_LDADD = $(LDADD) +am__DEPENDENCIES_1 = +alpined_DEPENDENCIES = local.o @top_srcdir@/pith/libpith.a \ + @top_srcdir@/pith/osdep/libpithosd.a \ + @top_srcdir@/pith/charconv/libpithcc.a \ + @top_srcdir@/c-client/c-client.a $(am__DEPENDENCIES_1) +am_alpineldap_OBJECTS = alpineldap.$(OBJEXT) busy.$(OBJEXT) \ + color.$(OBJEXT) imap.$(OBJEXT) ldap.$(OBJEXT) remote.$(OBJEXT) \ + signal.$(OBJEXT) debug.$(OBJEXT) status.$(OBJEXT) \ + stubs.$(OBJEXT) +alpineldap_OBJECTS = $(am_alpineldap_OBJECTS) +alpineldap_LDADD = $(LDADD) +alpineldap_DEPENDENCIES = local.o @top_srcdir@/pith/libpith.a \ + @top_srcdir@/pith/osdep/libpithosd.a \ + @top_srcdir@/pith/charconv/libpithcc.a \ + @top_srcdir@/c-client/c-client.a $(am__DEPENDENCIES_1) +DEFAULT_INCLUDES = +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +CCLD = $(CC) +LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \ + $(LDFLAGS) -o $@ +SOURCES = $(libwpcomm_la_SOURCES) $(alpined_SOURCES) \ + $(alpineldap_SOURCES) +DIST_SOURCES = $(libwpcomm_la_SOURCES) $(alpined_SOURCES) \ + $(alpineldap_SOURCES) +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_CFLAGS = @AM_CFLAGS@ +AM_LDFLAGS = `cat @top_srcdir@/c-client/LDFLAGS` +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CP = @CP@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +C_CLIENT_CFLAGS = @C_CLIENT_CFLAGS@ +C_CLIENT_GCCOPTLEVEL = @C_CLIENT_GCCOPTLEVEL@ +C_CLIENT_LDFLAGS = @C_CLIENT_LDFLAGS@ +C_CLIENT_SPECIALS = @C_CLIENT_SPECIALS@ +C_CLIENT_TARGET = @C_CLIENT_TARGET@ +C_CLIENT_WITH_IPV6 = @C_CLIENT_WITH_IPV6@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +GMSGFMT = @GMSGFMT@ +GMSGFMT_015 = @GMSGFMT_015@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +INTLLIBS = @INTLLIBS@ +INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ +ISPELLPROG = @ISPELLPROG@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBICONV = @LIBICONV@ +LIBINTL = @LIBINTL@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN = @LN@ +LN_S = @LN_S@ +LTLIBICONV = @LTLIBICONV@ +LTLIBINTL = @LTLIBINTL@ +LTLIBOBJS = @LTLIBOBJS@ +MAINT = @MAINT@ +MAKE = @MAKE@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +MSGFMT = @MSGFMT@ +MSGFMT_015 = @MSGFMT_015@ +MSGMERGE = @MSGMERGE@ +NM = @NM@ +NMEDIT = @NMEDIT@ +NPA_PROG = @NPA_PROG@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +POSUB = @POSUB@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +PWPROG = @PWPROG@ +RANLIB = @RANLIB@ +REGEX_BUILD = @REGEX_BUILD@ +RM = @RM@ +SED = @SED@ +SENDMAIL = @SENDMAIL@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SPELLPROG = @SPELLPROG@ +STRIP = @STRIP@ +USE_NLS = @USE_NLS@ +VERSION = @VERSION@ +WEB_BINDIR = @WEB_BINDIR@ +WEB_BUILD = @WEB_BUILD@ +WEB_PUBCOOKIE_BUILD = @WEB_PUBCOOKIE_BUILD@ +WEB_PUBCOOKIE_LIB = @WEB_PUBCOOKIE_LIB@ +WEB_PUBCOOKIE_LINK = @WEB_PUBCOOKIE_LINK@ +XGETTEXT = @XGETTEXT@ +XGETTEXT_015 = @XGETTEXT_015@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +acx_pthread_config = @acx_pthread_config@ +alpine_interactive_spellcheck = @alpine_interactive_spellcheck@ +alpine_simple_spellcheck = @alpine_simple_spellcheck@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_ECHO = @lt_ECHO@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ + +# This is because alpined, libwpcomm and friends are +# not intended for system-wide consumption +locbindir = @abs_srcdir@/../../bin +loclibdir = @abs_srcdir@/../../lib +alpined_SOURCES = alpined.c busy.c color.c imap.c ldap.c remote.c \ + signal.c debug.c status.c stubs.c \ + alpined.h color.h ldap.h + +alpineldap_SOURCES = alpineldap.c busy.c color.c imap.c ldap.c remote.c \ + signal.c debug.c status.c stubs.c \ + alpined.h color.h ldap.h + +LDADD = local.o \ + @top_srcdir@/pith/libpith.a \ + @top_srcdir@/pith/osdep/libpithosd.a \ + @top_srcdir@/pith/charconv/libpithcc.a \ + @top_srcdir@/c-client/c-client.a \ + $(WEB_PUBCOOKIE_LIB) + +loclib_LTLIBRARIES = libwpcomm.la +libwpcomm_la_SOURCES = wpcomm.c +libwpcomm_la_LDFLAGS = -rpath '$(loclibdir)' -version-info 1:0:0 +AM_CPPFLAGS = -I@top_builddir@/include -I@top_srcdir@/include +CLEANFILES = local.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .lo .o .obj +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign web/src/alpined.d/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign web/src/alpined.d/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): +install-loclibLTLIBRARIES: $(loclib_LTLIBRARIES) + @$(NORMAL_INSTALL) + test -z "$(loclibdir)" || $(MKDIR_P) "$(DESTDIR)$(loclibdir)" + @list='$(loclib_LTLIBRARIES)'; test -n "$(loclibdir)" || list=; \ + list2=; for p in $$list; do \ + if test -f $$p; then \ + list2="$$list2 $$p"; \ + else :; fi; \ + done; \ + test -z "$$list2" || { \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(loclibdir)'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(loclibdir)"; \ + } + +uninstall-loclibLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @list='$(loclib_LTLIBRARIES)'; test -n "$(loclibdir)" || list=; \ + for p in $$list; do \ + $(am__strip_dir) \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(loclibdir)/$$f'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(loclibdir)/$$f"; \ + done + +clean-loclibLTLIBRARIES: + -test -z "$(loclib_LTLIBRARIES)" || rm -f $(loclib_LTLIBRARIES) + @list='$(loclib_LTLIBRARIES)'; for p in $$list; do \ + dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \ + test "$$dir" != "$$p" || dir=.; \ + echo "rm -f \"$${dir}/so_locations\""; \ + rm -f "$${dir}/so_locations"; \ + done +libwpcomm.la: $(libwpcomm_la_OBJECTS) $(libwpcomm_la_DEPENDENCIES) + $(libwpcomm_la_LINK) -rpath $(loclibdir) $(libwpcomm_la_OBJECTS) $(libwpcomm_la_LIBADD) $(LIBS) +install-locbinPROGRAMS: $(locbin_PROGRAMS) + @$(NORMAL_INSTALL) + test -z "$(locbindir)" || $(MKDIR_P) "$(DESTDIR)$(locbindir)" + @list='$(locbin_PROGRAMS)'; test -n "$(locbindir)" || list=; \ + for p in $$list; do echo "$$p $$p"; done | \ + sed 's/$(EXEEXT)$$//' | \ + while read p p1; do if test -f $$p || test -f $$p1; \ + then echo "$$p"; echo "$$p"; else :; fi; \ + done | \ + sed -e 'p;s,.*/,,;n;h' -e 's|.*|.|' \ + -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ + sed 'N;N;N;s,\n, ,g' | \ + $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ + { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ + if ($$2 == $$4) files[d] = files[d] " " $$1; \ + else { print "f", $$3 "/" $$4, $$1; } } \ + END { for (d in files) print "f", d, files[d] }' | \ + while read type dir files; do \ + if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ + test -z "$$files" || { \ + echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(locbindir)$$dir'"; \ + $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(locbindir)$$dir" || exit $$?; \ + } \ + ; done + +uninstall-locbinPROGRAMS: + @$(NORMAL_UNINSTALL) + @list='$(locbin_PROGRAMS)'; test -n "$(locbindir)" || list=; \ + files=`for p in $$list; do echo "$$p"; done | \ + sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ + -e 's/$$/$(EXEEXT)/' `; \ + test -n "$$list" || exit 0; \ + echo " ( cd '$(DESTDIR)$(locbindir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(locbindir)" && rm -f $$files + +clean-locbinPROGRAMS: + @list='$(locbin_PROGRAMS)'; test -n "$$list" || exit 0; \ + echo " rm -f" $$list; \ + rm -f $$list || exit $$?; \ + test -n "$(EXEEXT)" || exit 0; \ + list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \ + echo " rm -f" $$list; \ + rm -f $$list +alpined$(EXEEXT): $(alpined_OBJECTS) $(alpined_DEPENDENCIES) + @rm -f alpined$(EXEEXT) + $(LINK) $(alpined_OBJECTS) $(alpined_LDADD) $(LIBS) +alpineldap$(EXEEXT): $(alpineldap_OBJECTS) $(alpineldap_DEPENDENCIES) + @rm -f alpineldap$(EXEEXT) + $(LINK) $(alpineldap_OBJECTS) $(alpineldap_LDADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/alpined.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/alpineldap.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/busy.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/color.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/debug.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/imap.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ldap.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/remote.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/signal.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/status.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stubs.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wpcomm.Plo@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'` + +.c.lo: +@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + set x; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: CTAGS +CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LTLIBRARIES) $(PROGRAMS) +installdirs: + for dir in "$(DESTDIR)$(loclibdir)" "$(DESTDIR)$(locbindir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool clean-locbinPROGRAMS \ + clean-loclibLTLIBRARIES mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: install-locbinPROGRAMS install-loclibLTLIBRARIES + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-locbinPROGRAMS uninstall-loclibLTLIBRARIES + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ + clean-libtool clean-locbinPROGRAMS clean-loclibLTLIBRARIES \ + ctags distclean distclean-compile distclean-generic \ + distclean-libtool distclean-tags distdir dvi dvi-am html \ + html-am info info-am install install-am install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-locbinPROGRAMS \ + install-loclibLTLIBRARIES install-man install-pdf \ + install-pdf-am install-ps install-ps-am install-strip \ + installcheck installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-compile \ + mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ + tags uninstall uninstall-am uninstall-locbinPROGRAMS \ + uninstall-loclibLTLIBRARIES + + +local.c: alpineldap.c color.c imap.c ldap.c remote.c signal.c \ + debug.c status.c stubs.c alpined.h color.h ldap.h + echo "char datestamp[]="\"`date`\"";" > local.c + echo "char hoststamp[]="\"`hostname`\"";" >> local.c + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/web/src/alpined.d/alpined.c b/web/src/alpined.d/alpined.c new file mode 100644 index 00000000..e35ba9e6 --- /dev/null +++ b/web/src/alpined.d/alpined.c @@ -0,0 +1,16404 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: alpined.c 1266 2009-07-14 18:39:12Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2008 University of Washington + * + * 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 + * + * ======================================================================== + */ + +/* ======================================================================== + Implement alpine TCL interfaces. Execute TCL interfaces + via interpreter reading commands and writing results over + UNIX domain socket. + ======================================================================== */ + + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" +#include "../../../c-client/imap4r1.h" + +#include "../../../pith/osdep/color.h" /* color support library */ +#include "../../../pith/osdep/canaccess.h" +#include "../../../pith/osdep/temp_nam.h" +#include "../../../pith/osdep/collate.h" +#include "../../../pith/osdep/filesize.h" +#include "../../../pith/osdep/writ_dir.h" +#include "../../../pith/osdep/err_desc.h" + +#include "../../../pith/stream.h" +#include "../../../pith/context.h" +#include "../../../pith/state.h" +#include "../../../pith/msgno.h" +#include "../../../pith/debug.h" +#include "../../../pith/init.h" +#include "../../../pith/conf.h" +#include "../../../pith/conftype.h" +#include "../../../pith/detoken.h" +#include "../../../pith/flag.h" +#include "../../../pith/help.h" +#include "../../../pith/remote.h" +#include "../../../pith/status.h" +#include "../../../pith/mailcmd.h" +#include "../../../pith/savetype.h" +#include "../../../pith/save.h" +#include "../../../pith/reply.h" +#include "../../../pith/sort.h" +#include "../../../pith/ldap.h" +#include "../../../pith/addrbook.h" +#include "../../../pith/ablookup.h" +#include "../../../pith/takeaddr.h" +#include "../../../pith/bldaddr.h" +#include "../../../pith/copyaddr.h" +#include "../../../pith/thread.h" +#include "../../../pith/folder.h" +#include "../../../pith/mailview.h" +#include "../../../pith/indxtype.h" +#include "../../../pith/icache.h" +#include "../../../pith/mailindx.h" +#include "../../../pith/mailpart.h" +#include "../../../pith/mimedesc.h" +#include "../../../pith/detach.h" +#include "../../../pith/newmail.h" +#include "../../../pith/charset.h" +#include "../../../pith/util.h" +#include "../../../pith/rfc2231.h" +#include "../../../pith/string.h" +#include "../../../pith/send.h" +#include "../../../pith/options.h" +#include "../../../pith/list.h" +#include "../../../pith/mimetype.h" +#include "../../../pith/mailcap.h" +#include "../../../pith/sequence.h" +#include "../../../pith/smime.h" +#include "../../../pith/url.h" +#include "../../../pith/charconv/utf8.h" + +#include "alpined.h" +#include "color.h" +#include "imap.h" +#include "ldap.h" +#include "debug.h" +#include "stubs.h" + +#include <tcl.h> + + +/* + * Fake screen dimension for word wrap and such + */ +#define FAKE_SCREEN_WIDTH 80 +#define FAKE_SCREEN_LENGTH 24 + +/* + * Aribtrary minimum display width (in characters) + */ +#define MIN_SCREEN_COLS 20 + + +/* + * Maximum number of lines allowed in signatures + */ +#define SIG_MAX_LINES 24 +#define SIG_MAX_COLS 1024 + + +/* + * Number of seconds we'll wait before we assume the client has wondered + * on to more interesting content + */ +#define PE_INPUT_TIMEOUT 1800 + + +/* + * Posting error lenght max + */ +#define WP_MAX_POST_ERROR 128 + + +/* + * AUTH Response Tokens + */ +#define AUTH_EMPTY_STRING "NOPASSWD" +#define AUTH_FAILURE_STRING "BADPASSWD" + +/* + * CERT Response Tokens + */ +#define CERT_QUERY_STRING "CERTQUERY" +#define CERT_FAILURE_STRING "CERTFAIL" + + +/* + * Charset used within alpined and to communicate with alpined + * Note: posting-charset still respected + */ +#define WP_INTERNAL_CHARSET "UTF-8" + + +/* + * Globals referenced throughout pine... + */ +struct pine *ps_global; /* THE global variable! */ + + +/* + * More global state + */ +long gPeITop, gPeICount; + +long gPeInputTimeout = PE_INPUT_TIMEOUT; +long gPEAbandonTimeout = 0; + + +/* + * Authorization issues + */ +int peNoPassword, peCredentialError; +int peCertFailure, peCertQuery; +char peCredentialRequestor[CRED_REQ_SIZE]; + +char *peSocketName; + +char **peTSig; + +CONTEXT_S *config_context_list; + +STRLIST_S *peCertHosts; + +bitmap_t changed_feature_list; +#define F_CH_ON(feature) (bitnset((feature),changed_feature_list)) +#define F_CH_OFF(feature) (!F_CH_ON(feature)) +#define F_CH_TURN_ON(feature) (setbitn((feature),changed_feature_list)) +#define F_CH_TURN_OFF(feature) (clrbitn((feature),changed_feature_list)) +#define F_CH_SET(feature,value) ((value) ? F_CH_TURN_ON((feature)) \ + : F_CH_TURN_OFF((feature))) + + +typedef struct _status_msg { + time_t posted; + unsigned type:3; + unsigned seen:1; + long id; + char *text; + struct _status_msg *next; +} STATMSG_S; + +static STATMSG_S *peStatList; + +typedef struct _composer_attachment { + unsigned file:1; + unsigned body:1; + char *id; + union { + struct { + char *local; + char *remote; + char *type; + char *subtype; + char *description; + long size; + } f; + struct { + BODY *body; + } b; + struct { + long msgno; + char *part; + } msg; + } l; + struct _composer_attachment *next; +} COMPATT_S; + +static COMPATT_S *peCompAttach; + +/* + * Holds data passed + */ +typedef struct _msg_data { + ENVELOPE *outgoing; + METAENV *metaenv; + PINEFIELD *custom; + STORE_S *msgtext; + STRLIST_S *attach; + char *fcc; + int fcc_colid; + int postop_fcc_no_attach; + char *charset; + char *priority; + int (*postfunc)(METAENV *, BODY *, char *, CONTEXT_S **, char *); + unsigned flowed:1; + unsigned html:1; + unsigned qualified_addrs:1; +} MSG_COL_S; + + +/* + * locally global structure to keep track of various bits of state + * needed to collect filtered output + */ +static struct _embedded_data { + Tcl_Interp *interp; + Tcl_Obj *obj; + STORE_S *store; + long uid; + HANDLE_S *handles; + char inhandle; + ENVELOPE *env; + BODY *body; + struct { + char fg[7]; + char bg[7]; + char fgdef[7]; + char bgdef[7]; + } color; +} peED; + + +/* + * RSS stream cache + */ +typedef struct _rss_cache_s { + char *link; + time_t stale; + int referenced; + RSS_FEED_S *feed; +} RSS_CACHE_S; + +#define RSS_NEWS_CACHE_SIZE 1 +#define RSS_WEATHER_CACHE_SIZE 1 + + +#ifdef ENABLE_LDAP +WPLDAP_S *wpldap_global; +#endif + +/* + * random string generator flags + */ +#define PRS_NONE 0x0000 +#define PRS_LOWER_CASE 0x0001 +#define PRS_UPPER_CASE 0x0002 +#define PRS_MIXED_CASE 0x0004 + +/* + * peSaveWork flag definitions + */ +#define PSW_NONE 0x00 +#define PSW_COPY 0x01 +#define PSW_MOVE 0x02 + +/* + * Message Collector flags + */ +#define PMC_NONE 0x00 +#define PMC_FORCE_QUAL 0x01 +#define PMC_PRSRV_ATT 0x02 + +/* + * length of thread info string + */ +#define WP_MAX_THRD_S 64 + +/* + * static buf size for putenv() if necessary + */ +#define PUTENV_MAX 64 + + + +/*---------------------------------------------------------------------- + General use big buffer. It is used in the following places: + compose_mail: while parsing header of postponed message + append_message2: while writing header into folder + q_status_messageX: while doing printf formatting + addr_book: Used to return expanded address in. (Can only use here + because mm_log doesn't q_status on PARSE errors !) + alpine.c: When address specified on command line + init.c: When expanding variable values + and many many more... + + ----*/ +char tmp_20k_buf[20480]; + + + + +/* Internal prototypes */ +void peReturn(int, char *, char *); +int peWrite(int, char *); +char *peCreateUserContext(Tcl_Interp *, char *, char *, char *); +void peDestroyUserContext(struct pine **); +char *peLoadConfig(struct pine *); +int peCreateStream(Tcl_Interp *, CONTEXT_S *, char *, int); +void peDestroyStream(struct pine *); +void pePrepareForAuthException(void); +char *peAuthException(void); +void peInitVars(struct pine *); +int peSelect(Tcl_Interp *, int, Tcl_Obj **, int); +int peSelectNumber(Tcl_Interp *, int, Tcl_Obj **, int); +int peSelectDate(Tcl_Interp *, int, Tcl_Obj **, int); +int peSelectText(Tcl_Interp *, int, Tcl_Obj **, int); +int peSelectStatus(Tcl_Interp *, int, Tcl_Obj **, int); +char *peSelValTense(Tcl_Obj *); +char *peSelValYear(Tcl_Obj *); +char *peSelValMonth(Tcl_Obj *); +char *peSelValDay(Tcl_Obj *); +int peSelValCase(Tcl_Obj *); +int peSelValField(Tcl_Obj *); +int peSelValFlag(Tcl_Obj *); +int peSelected(Tcl_Interp *, int, Tcl_Obj **, int); +int peSelectError(Tcl_Interp *, char *); +int peApply(Tcl_Interp *, int, Tcl_Obj **); +char *peApplyFlag(MAILSTREAM *, MSGNO_S *, char, int, long *); +int peApplyError(Tcl_Interp *, char *); +int peIndexFormat(Tcl_Interp *); +int peAppendIndexParts(Tcl_Interp *, imapuid_t, Tcl_Obj *, int *); +int peAppendIndexColor(Tcl_Interp *, imapuid_t, Tcl_Obj *, int *); +int peMessageStatusBits(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +char *peMsgStatBitString(struct pine *, MAILSTREAM *, MSGNO_S *, long, long, long, int *); +Tcl_Obj *peMsgStatNameList(Tcl_Interp *, struct pine *, MAILSTREAM *, MSGNO_S *, long, long, long, int *); +int peNewMailResult(Tcl_Interp *); +int peMessageSize(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageDate(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageSubject(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageFromAddr(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageToAddr(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageCcAddr(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageField(Tcl_Interp *, imapuid_t, char *); +int peMessageStatus(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageCharset(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageBounce(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageSpamNotice(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +char *peSendSpamReport(long, char *, char *, char *); +int peMsgnoFromUID(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageText(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageHeader(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +void peFormatEnvelope(MAILSTREAM *, long, char *, ENVELOPE *, gf_io_t, long, char *, int); +void peFormatEnvelopeAddress(MAILSTREAM *, long, char *, char *, ADDRESS *, int, char *, gf_io_t); +void peFormatEnvelopeNewsgroups(char *, char *, int, gf_io_t); +void peFormatEnvelopeText(char *, char *); +int peMessageAttachments(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessageBody(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMessagePartFromCID(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peLocateBodyByCID(char *, char *, BODY *); +char *peColorStr(char *, char *); +int peInterpWritec(int); +int peInterpFlush(void); +int peNullWritec(int); +void peGetMimeTyping(BODY *, Tcl_Obj **, Tcl_Obj **, Tcl_Obj **, Tcl_Obj **); +int peGetFlag(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peIsFlagged(MAILSTREAM *, imapuid_t, char *); +int peSetFlag(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMsgSelect(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peReplyHeaders(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peAppListF(Tcl_Interp *, Tcl_Obj *, char *, ...); +void pePatAppendID(Tcl_Interp *, Tcl_Obj *, PAT_S *); +void pePatAppendPattern(Tcl_Interp *, Tcl_Obj *, PAT_S *); +char *pePatStatStr(int); +int peReplyText(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peSoStrToList(Tcl_Interp *, Tcl_Obj *, STORE_S *); +int peForwardHeaders(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peForwardText(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peDetach(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peAttachInfo(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peSaveDefault(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peSaveWork(Tcl_Interp *, imapuid_t, int, Tcl_Obj **, long); +int peSave(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peCopy(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peMove(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peGotoDefault(Tcl_Interp *, imapuid_t, Tcl_Obj **); +int peTakeaddr(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peTakeFrom(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peAddSuggestedContactInfo(Tcl_Interp *, Tcl_Obj *, ADDRESS *); +int peReplyQuote(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +long peMessageNumber(imapuid_t); +long peSequenceNumber(imapuid_t); +int peMsgCollector(Tcl_Interp *, int, Tcl_Obj **, + int (*)(METAENV *, BODY *, char *, CONTEXT_S **, char *), long); +int peMsgCollected(Tcl_Interp *, MSG_COL_S *, char *, long); +void peMsgSetParm(PARAMETER **, char *, char *); +Tcl_Obj *peMsgAttachCollector(Tcl_Interp *, BODY *); +int peFccAppend(Tcl_Interp *, Tcl_Obj *, char *, int); +int peDoPost(METAENV *, BODY *, char *, CONTEXT_S **, char *); +int peDoPostpone(METAENV *, BODY *, char *, CONTEXT_S **, char *); +int peWriteSig (Tcl_Interp *, char *, Tcl_Obj **); +int peInitAddrbooks(Tcl_Interp *, int); +int peRuleStatVal(char *, int *); +int peRuleSet(Tcl_Interp *, Tcl_Obj **); +int peAppendCurrentSort(Tcl_Interp *interp); +int peAppendDefaultSort(Tcl_Interp *interp); +#if 0 +ADDRESS *peAEToAddress(AdrBk_Entry *); +char *peAEFcc(AdrBk_Entry *); +#endif +NAMEVAL_S *sort_key_rules(int); +NAMEVAL_S *wp_indexheight_rules(int); +PINEFIELD *peCustomHdrs(void); +STATMSG_S *sml_newmsg(int, char *); +char *sml_getmsg(void); +char **sml_getmsgs(void); +void sml_seen(void); +#ifdef ENABLE_LDAP +int peLdapQueryResults(Tcl_Interp *); +int peLdapStrlist(Tcl_Interp *, Tcl_Obj *, char **); +int init_ldap_pname(struct pine *); +#endif /* ENABLE_LDAP */ +char *strqchr(char *, int, int *, int); +Tcl_Obj *wp_prune_folders(CONTEXT_S *, char *, int, char *, + unsigned, int *, int, Tcl_Interp *); +int hex_colorstr(char *, char *); +int hexval(char); +int ascii_colorstr(char *, char *); +COMPATT_S *peNewAttach(void); +void peFreeAttach(COMPATT_S **); +COMPATT_S *peGetAttachID(char *); +char *peFileAttachID(char *, char *, char *, char *, char *, int); +char *peBodyAttachID(BODY *); +void peBodyMoveContents(BODY *, BODY *); +int peClearAttachID(char *); +char *peRandomString(char *, int, int); +void ms_init(STRING *, void *, unsigned long); +char ms_next(STRING *); +void ms_setpos(STRING *, unsigned long); +long peAppendMsg(MAILSTREAM *, void *, char **, char **, STRING **); +int remote_pinerc_failure(void); +char *peWebAlpinePrefix(void); +void peNewMailAnnounce(MAILSTREAM *, long, long); +int peMessageNeedPassphrase(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); +int peRssReturnFeed(Tcl_Interp *, char *, char *); +int peRssPackageFeed(Tcl_Interp *, RSS_FEED_S *); +RSS_FEED_S *peRssFeed(Tcl_Interp *, char *, char *); +RSS_FEED_S *peRssFetch(Tcl_Interp *, char *); +void peRssComponentFree(char **,char **,char **,char **,char **,char **); +void peRssClearCacheEntry(RSS_CACHE_S *); + + +/* Prototypes for Tcl-exported methods */ +int PEInit(Tcl_Interp *interp, char *); +void PEExitCleanup(ClientData); +int PEInfoCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEConfigCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEDebugCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PESessionCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEMailboxCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEThreadCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEMessageCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEFolderCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEComposeCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEPostponeCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEAddressCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PEClistCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PELdapCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +int PERssCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); + +/* Append package */ +typedef struct append_pkg { + MAILSTREAM *stream; /* source stream */ + unsigned long msgno; /* current message number */ + unsigned long msgmax; /* maximum message number */ + char *flags; /* current flags */ + char *date; /* message internal date */ + STRING *message; /* stringstruct of message */ +} APPEND_PKG; + +STRINGDRIVER mstring = { + ms_init, /* initialize string structure */ + ms_next, /* get next byte in string structure */ + ms_setpos /* set position in string structure */ +}; + + +/*---------------------------------------------------------------------- + main routine -- entry point + + Args: argv, argc -- The command line arguments + + + Setup c-client drivers and dive into TCL interpreter engine + + ----*/ + +int +main(int argc, char *argv[]) +{ + int ev = 1, s, cs, n, co, o, l, bl = 256, argerr; + char *buf, sname[256]; + struct sockaddr_un name; + Tcl_Interp *interp; +#if PUBCOOKIE + extern AUTHENTICATOR auth_gss_proxy; +#endif + + srandom(getpid() + time(0)); + + /*---------------------------------------------------------------------- + Initialize c-client + ----------------------------------------------------------------------*/ + + /* + * NO LOCAL DRIVERS ALLOWED + * For this to change pintecld *MUST* be running under the user's UID and + * and signal.[ch] need to get fixed to handle KOD rather than change + * the debug level + */ + mail_link (&imapdriver); /* link in the imap driver */ + mail_link (&unixdriver); /* link in the unix driver */ + mail_link (&dummydriver); /* link in the dummy driver */ + + /* link authentication drivers */ +#if PUBCOOKIE + auth_link (&auth_gss_proxy); /* pubcoookie proxy authenticator */ +#endif + auth_link (&auth_md5); /* link in the md5 authenticator */ + auth_link (&auth_pla); + auth_link (&auth_log); /* link in the log authenticator */ + ssl_onceonlyinit (); + mail_parameters (NIL,SET_DISABLEPLAINTEXT,(void *) 2); + +#if PUBCOOKIE + /* if REMOTE_USER set, use it as username */ + if(buf = getenv("REMOTE_USER")) + env_init(buf, "/tmp"); +#endif + + if(!mail_parameters(NULL, DISABLE_DRIVER, "unix")){ + fprintf(stderr, "Can't disable unix driver"); + exit(1); + } + + /* + * Set network timeouts so we don't hang forever + * The open timeout can be pretty short since we're + * just opening tcp connection. The read timeout needs + * to be longer because the response to some actions can + * take awhile. Hopefully this is well within httpd's + * cgi timeout threshold. + */ + mail_parameters(NULL, SET_OPENTIMEOUT, (void *)(long) 30); + mail_parameters(NULL, SET_READTIMEOUT, (void *)(long) 60); + + /*---------------------------------------------------------------------- + Initialize pith library + ----------------------------------------------------------------------*/ + pith_opt_remote_pinerc_failure = remote_pinerc_failure; + pith_opt_user_agent_prefix = peWebAlpinePrefix; + pith_opt_newmail_announce = peNewMailAnnounce; + + setup_for_index_index_screen(); + + + /*---------------------------------------------------------------------- + Parse arguments + ----------------------------------------------------------------------*/ + debug = 0; + for(argerr = 0; !argerr && ((n = getopt(argc,argv,"d")) != -1); ) { + switch(n) { + case 'd' : debug++; break; + case '?' : argerr = 1; break; + } + } + + if(argerr || optind != argc){ + char *p = strrchr(argv[0],'/'); + fprintf(stderr, "Usage: %s [-d]\n", p ? p + 1 : argv[0]); + exit(1); + } + + /*---------------------------------------------------------------------- + Hop into the Tcl processing loop + ----------------------------------------------------------------------*/ + + buf = (char *) fs_get(bl * sizeof(char)); + + if(fgets(sname, 255, stdin) && *sname){ + if(sname[l = strlen(sname) - 1] == '\n') + sname[l] = '\0'; + + if((s = socket(AF_UNIX, SOCK_STREAM, 0)) != -1){ + + name.sun_family = AF_UNIX; + strcpy(name.sun_path, peSocketName = sname); + l = sizeof(name); + + if(bind(s, (struct sockaddr *) &name, l) == 0){ + if(listen(s, 5) == 0){ + /* + * after the groundwork's done, go into the background. + * the fork saves the caller from invoking us in the background + * which introduces a timing race between the first client + * request arrival and our being prepared to accept it. + */ + if(debug < 10){ + switch(fork()){ + case -1 : /* error */ + perror("fork"); + exit(1); + + case 0 : /* child */ + close(0); /* disassociate */ + close(1); + close(2); + setpgrp(0, 0); + break; + + default : /* parent */ + exit(0); + } + } + + debug_init(); + dprint((SYSDBG_INFO, "started")); + + interp = Tcl_CreateInterp(); + + PEInit(interp, sname); + + while(1){ + struct timeval tv; + fd_set rfd; + + FD_ZERO(&rfd); + FD_SET(s, &rfd); + tv.tv_sec = (gPEAbandonTimeout) ? gPEAbandonTimeout : gPeInputTimeout; + tv.tv_usec = 0; + if((n = select(s+1, &rfd, 0, 0, &tv)) > 0){ + socklen_t ll = l; + + gPEAbandonTimeout = 0; + + if((cs = accept(s, (struct sockaddr *) &name, &ll)) == -1){ + dprint((SYSDBG_ERR, "accept failure: %s", + error_description(errno))); + break; + } + + dprint((5, "accept success: %d", cs)); + + /* + * tcl commands are prefixed with a number representing + * the length of the command string and a newline character. + * the characters representing the length and the newline + * are not included in the command line length calculation. + */ + o = co = 0; + while((n = read(cs, buf + o, bl - o - 1)) > 0){ + o += n; + if(!co){ + int i, x = 0; + + for(i = 0; i < o; i++) + if(buf[i] == '\n'){ + co = ++i; + l = x + co; + if(bl < l + 1){ + bl = l + 1; + fs_resize((void **) &buf, bl * sizeof(char)); + } + + break; + } + else + x = (x * 10) + (buf[i] - '0'); + } + + if(o && o == l) + break; + } + + if(n == 0){ + dprint((SYSDBG_ERR, "read EOF")); + } + else if(n < 0){ + dprint((SYSDBG_ERR, "read failure: %s", error_description(errno))); + } + else{ + buf[o] = '\0'; + + /* Log every Eval if somebody *really* wants to see it. */ + if(debug > 6){ + char dbuf[5120]; + int dlim = (debug >= 9) ? 256 : 5120 - 32; + + snprintf(dbuf, sizeof(dbuf), "Tcl_Eval(%.*s)", dlim, &buf[co]); + + /* But DON'T log any clear-text credentials */ + if(dbuf[9] == 'P' + && dbuf[10] == 'E' + && dbuf[11] == 'S' + && !strncmp(dbuf + 12, "ession creds ", 13)){ + char *p; + + for(p = &dbuf[25]; *p; p++) + *p = 'X'; + } + + dprint((1, dbuf)); + } + + switch(Tcl_Eval(interp, &buf[co])){ + case TCL_OK : peReturn(cs, "OK", interp->result); break; + case TCL_ERROR : peReturn(cs, "ERROR", interp->result); break; + case TCL_BREAK : peReturn(cs, "BREAK", interp->result); break; + case TCL_RETURN : peReturn(cs, "RETURN", interp->result); break; + default : peReturn(cs, "BOGUS", "eval returned unexpected value"); break; + } + } + + close(cs); + } + else if(errno != EINTR){ + if(n < 0){ + dprint((SYSDBG_ALERT, "select failure: %s", error_description(errno))); + } + else{ + dprint((SYSDBG_INFO, "timeout after %d seconds", tv.tv_sec)); + } + + Tcl_Exit(0); + + /* Tcl_Exit should never return. Getting here is an error. */ + dprint((SYSDBG_ERR, "Tcl_Exit failure")); + } + } + } + else + perror("listen"); + } + else + perror("bind"); + + close(s); + unlink(sname); + } + else + perror("socket"); + } + else + fprintf(stderr, "Can't read socket name\n"); + + exit(ev); +} + + +/* + * peReturn - common routine to return TCL result + */ +void +peReturn(int sock, char *status, char *result) +{ + if(peWrite(sock, status)) + if(peWrite(sock, "\n")) + peWrite(sock, result); +} + +/* + * peWrite - write all the given string on the given socket + */ +int +peWrite(int sock, char *s) +{ + int i, n; + + for(i = 0, n = strlen(s); n; n = n - i) + if((i = write(sock, s + i, n)) < 0){ + dprint((SYSDBG_ERR, "write: %s", error_description(errno))); + return(0); + } + + return(1); +} + +/* + * PEInit - Initialize exported TCL functions + */ +int +PEInit(Tcl_Interp *interp, char *sname) +{ + dprint((2, "PEInit: %s", sname)); + + if(Tcl_Init(interp) == TCL_ERROR) { + return(TCL_ERROR); + } + + Tcl_CreateObjCommand(interp, "PEInfo", PEInfoCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEConfig", PEConfigCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEDebug", PEDebugCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PESession", PESessionCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEFolder", PEFolderCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEMailbox", PEMailboxCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEThread", PEThreadCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEMessage", PEMessageCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PECompose", PEComposeCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEPostpone", PEPostponeCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEAddress", PEAddressCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PEClist", PEClistCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PELdap", PELdapCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateObjCommand(interp, "PERss", PERssCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tcl_CreateExitHandler(PEExitCleanup, sname); + +#ifdef ENABLE_LDAP + wpldap_global = (WPLDAP_S *)fs_get(sizeof(WPLDAP_S)); + wpldap_global->query_no = 0; + wpldap_global->ldap_search_list = NULL; +#endif /* ENABLE_LDAP */ + + return(TCL_OK); +} + + +void +PEExitCleanup(ClientData clientData) +{ + dprint((4, "PEExitCleanup")); + + if(ps_global){ + /* destroy any open stream */ + peDestroyStream(ps_global); + + /* destroy user context */ + peDestroyUserContext(&ps_global); + } + +#ifdef ENABLE_LDAP + if(wpldap_global){ + if(wpldap_global->ldap_search_list) + free_wpldapres(wpldap_global->ldap_search_list); + fs_give((void **)&wpldap_global); + } +#endif /* ENABLE_LDAP */ + + if((char *) clientData) + unlink((char *) clientData); + + peFreeAttach(&peCompAttach); + + dprint((SYSDBG_INFO, "finished")); +} + + +/* + * PEInfoCmd - export various bits of alpine state + */ +int +PEInfoCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *err = "Unknown PEInfo request"; + + dprint((2, "PEInfoCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + } + else{ + char *s1 = Tcl_GetStringFromObj(objv[1], NULL); + + if(s1){ + if(!strcmp(s1, "colorset")){ + char *varname, *fghex, *bghex; + char tvname[256], asciicolor[256]; + struct variable *vtmp; + Tcl_Obj **cObj; + int cObjc; + SPEC_COLOR_S *hcolors, *thc; + + if(!(varname = Tcl_GetStringFromObj(objv[2], NULL))){ + Tcl_SetResult(interp, "colorset: can't read variable name", TCL_STATIC); + return(TCL_ERROR); + } + + if(!strcmp(varname, "viewer-hdr-colors")){ + char *newhdr = NULL, *newpat = NULL, *utype; + int hindex, i; + + if(objc < 5){ + Tcl_SetResult(interp, "colorset: too few view-hdr args", TCL_STATIC); + return(TCL_ERROR); + } + + hcolors = spec_colors_from_varlist(ps_global->VAR_VIEW_HDR_COLORS, 0); + if(!(utype = Tcl_GetStringFromObj(objv[3], NULL))){ + Tcl_SetResult(interp, "colorset: can't read operation", TCL_STATIC); + return(TCL_ERROR); + } + + if(!strcmp(utype, "delete")){ + if(!hcolors){ + Tcl_SetResult(interp, "colorset: no viewer-hdrs to delete", TCL_STATIC); + return(TCL_ERROR); + } + + if(Tcl_GetIntFromObj(interp, objv[4], &hindex) == TCL_ERROR){ + Tcl_SetResult(interp, "colorset: can't read index", TCL_STATIC); + return(TCL_ERROR); + } + + if(hindex == 0){ + thc = hcolors; + hcolors = hcolors->next; + thc->next = NULL; + free_spec_colors(&thc); + } + else{ + /* zero based */ + for(thc = hcolors, i = 1; thc && i < hindex; thc = thc->next, i++) + ; + + if(thc && thc->next){ + SPEC_COLOR_S *thc2 = thc->next; + + thc->next = thc2->next; + thc2->next = NULL; + free_spec_colors(&thc2); + } + else{ + Tcl_SetResult(interp, "colorset: invalid index", TCL_STATIC); + return(TCL_ERROR); + } + } + } + else if(!strcmp(utype, "add")){ + if(objc != 6){ + Tcl_SetResult(interp, "colorset: wrong number of view-hdr add args", TCL_STATIC); + return(TCL_ERROR); + } + + if(Tcl_ListObjGetElements(interp, objv[4], &cObjc, &cObj) != TCL_OK) + return (TCL_ERROR); + + if(cObjc != 2){ + Tcl_SetResult(interp, "colorset: wrong number of hdrs for view-hdr add", TCL_STATIC); + return(TCL_ERROR); + } + + newhdr = Tcl_GetStringFromObj(cObj[0], NULL); + newpat = Tcl_GetStringFromObj(cObj[1], NULL); + if(Tcl_ListObjGetElements(interp, objv[5], &cObjc, &cObj) != TCL_OK) + return (TCL_ERROR); + + if(cObjc != 2){ + Tcl_SetResult(interp, "colorset: wrong number of colors for view-hdr add", TCL_STATIC); + return(TCL_ERROR); + } + + fghex = Tcl_GetStringFromObj(cObj[0], NULL); + bghex = Tcl_GetStringFromObj(cObj[1], NULL); + if(newhdr && newpat && fghex && bghex){ + SPEC_COLOR_S **hcp; + + for(hcp = &hcolors; *hcp != NULL; hcp = &(*hcp)->next) + ; + + *hcp = (SPEC_COLOR_S *)fs_get(sizeof(SPEC_COLOR_S)); + (*hcp)->inherit = 0; + (*hcp)->spec = cpystr(newhdr); + (*hcp)->fg = cpystr((ascii_colorstr(asciicolor, fghex) == 0) ? asciicolor : "black"); + (*hcp)->bg = cpystr((ascii_colorstr(asciicolor, bghex) == 0) ? asciicolor : "white"); + + if(newpat && *newpat) + (*hcp)->val = string_to_pattern(newpat); + else + (*hcp)->val = NULL; + + (*hcp)->next = NULL; + } + else{ + Tcl_SetResult(interp, "colorset: invalid args for view-hdr add", TCL_STATIC); + return(TCL_ERROR); + } + } + else if(!strcmp(utype, "update")){ + if(objc != 6){ + Tcl_SetResult(interp, "colorset: wrong number of view-hdr update args", TCL_STATIC); + return(TCL_ERROR); + } + + if(!(Tcl_ListObjGetElements(interp, objv[4], &cObjc, &cObj) == TCL_OK + && cObjc == 3 + && Tcl_GetIntFromObj(interp, cObj[0], &hindex) == TCL_OK + && (newhdr = Tcl_GetStringFromObj(cObj[1], NULL)) + && (newpat = Tcl_GetStringFromObj(cObj[2], NULL)))){ + Tcl_SetResult(interp, "colorset: view-hdr update can't read index or header", TCL_STATIC); + return (TCL_ERROR); + } + + if(!(Tcl_ListObjGetElements(interp, objv[5], &cObjc, &cObj) == TCL_OK + && cObjc == 2 + && (fghex = Tcl_GetStringFromObj(cObj[0], NULL)) + && (bghex = Tcl_GetStringFromObj(cObj[1], NULL)))){ + Tcl_SetResult(interp, "colorset: view-hdr update can't read colors", TCL_STATIC); + return (TCL_ERROR); + } + + for(thc = hcolors, i = 0; thc && i < hindex; thc = thc->next, i++) + ; + + if(!thc){ + Tcl_SetResult(interp, "colorset: view-hdr update invalid index", TCL_STATIC); + return (TCL_ERROR); + } + + if(thc->spec) + fs_give((void **)&thc->spec); + + thc->spec = cpystr(newhdr); + if(ascii_colorstr(asciicolor, fghex) == 0) { + if(thc->fg) + fs_give((void **)&thc->fg); + + thc->fg = cpystr(asciicolor); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid foreground color value %.100s", fghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(ascii_colorstr(asciicolor, bghex) == 0) { + if(thc->bg) + fs_give((void **)&thc->bg); + + thc->bg = cpystr(asciicolor); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background color value %.100s", bghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(thc->val) + fs_give((void **)&thc->val); + + if(newpat && *newpat){ + thc->val = string_to_pattern(newpat); + } + } + else{ + Tcl_SetResult(interp, "colorset: unknown operation", TCL_STATIC); + return(TCL_ERROR); + } + + vtmp = &ps_global->vars[V_VIEW_HDR_COLORS]; + for(i = 0; vtmp->main_user_val.l && vtmp->main_user_val.l[i]; i++) + fs_give((void **)&vtmp->main_user_val.l[i]); + + if(vtmp->main_user_val.l) + fs_give((void **)&vtmp->main_user_val.l); + + vtmp->main_user_val.l = varlist_from_spec_colors(hcolors); + set_current_val(vtmp, FALSE, FALSE); + free_spec_colors(&hcolors); + return(TCL_OK); + } + else { + if(objc != 4){ + Tcl_SetResult(interp, "colorset: Wrong number of args", TCL_STATIC); + return(TCL_ERROR); + } + + if(!(Tcl_ListObjGetElements(interp, objv[3], &cObjc, &cObj) == TCL_OK + && cObjc == 2 + && (fghex = Tcl_GetStringFromObj(cObj[0], NULL)) + && (bghex = Tcl_GetStringFromObj(cObj[1], NULL)))){ + Tcl_SetResult(interp, "colorset: Problem reading fore/back ground colors", TCL_STATIC); + return (TCL_ERROR); + } + + snprintf(tvname, sizeof(tvname), "%.200s-foreground-color", varname); + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++) + ; + + if(!vtmp->name || vtmp->is_list){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background var %.100s", varname); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(ascii_colorstr(asciicolor, fghex) == 0) { + if(vtmp->main_user_val.p) + fs_give((void **)&vtmp->main_user_val.p); + + vtmp->main_user_val.p = cpystr(asciicolor); + set_current_val(vtmp, FALSE, FALSE); + if(!strucmp(varname, "normal")) + pico_set_fg_color(asciicolor); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid color value %.100s", fghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + snprintf(tvname, sizeof(tvname), "%.200s%.50s", varname, "-background-color"); + vtmp++; + if((vtmp->name && strucmp(vtmp->name, tvname)) || !vtmp->name) + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++) + ; + + if(!vtmp->name || vtmp->is_list){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background var %.100s", varname); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(ascii_colorstr(asciicolor, bghex) == 0) { + if(vtmp->main_user_val.p) + fs_give((void **)&vtmp->main_user_val.p); + + vtmp->main_user_val.p = cpystr(asciicolor); + set_current_val(vtmp, FALSE, FALSE); + if(!strucmp(varname, "normal")) + pico_set_bg_color(asciicolor); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background color value %.100s", bghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + Tcl_SetResult(interp, "1", TCL_STATIC); + return(TCL_OK); + } + } + else if(!strcmp(s1, "lappend")){ + if(objc >= 4){ + Tcl_Obj *dObj; + int i; + + if((dObj = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG)) != NULL){ + for(i = 3; i < objc; i++) + if(Tcl_ListObjAppendElement(interp, dObj, objv[i]) != TCL_OK) + return(TCL_ERROR); + + if(i == objc){ + return(TCL_OK); + } + } + else + err = "PEInfo lappend: Unknown list name"; + } + else + err = "PEInfo lappend: Too few args"; + } + else if(objc == 2){ + if(!strcmp(s1, "version")){ + char buf[256]; + + /* + * CMD: version + * + * Returns: string representing Pine version + * engine built on + */ + Tcl_SetResult(interp, ALPINE_VERSION, TCL_STATIC); + return(TCL_OK); + } + else if(!strcmp(s1, "revision")){ + char buf[16]; + + /* + * CMD: revision + * + * Returns: string representing Pine SVN revision + * engine built on + */ + + Tcl_SetResult(interp, get_alpine_revision_number(buf, sizeof(buf)), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "key")){ + static char key[64]; + + if(!key[0]) + peRandomString(key,32,PRS_UPPER_CASE); + + Tcl_SetResult(interp, key, TCL_STATIC); + return(TCL_OK); + } + else if(!strcmp(s1, "indexheight")){ + Tcl_SetResult(interp, ps_global->VAR_WP_INDEXHEIGHT ? + ps_global->VAR_WP_INDEXHEIGHT : "", TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "indexlines")){ + Tcl_SetResult(interp, ps_global->VAR_WP_INDEXLINES ? + ps_global->VAR_WP_INDEXLINES : "0", TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "aggtabstate")){ + Tcl_SetResult(interp, ps_global->VAR_WP_AGGSTATE ? + ps_global->VAR_WP_AGGSTATE : "0", TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "alpinestate")){ + char *wps, *p, *q; + + if((wps = ps_global->VAR_WP_STATE) != NULL){ + wps = p = q = cpystr(wps); + do + if(*q == '\\' && *(q+1) == '$') + q++; + while((*p++ = *q++) != '\0'); + } + + Tcl_SetResult(interp, wps ? wps : "", TCL_VOLATILE); + + if(wps) + fs_give((void **) &wps); + + return(TCL_OK); + } + else if(!strcmp(s1, "foreground")){ + char *color; + + if(!((color = pico_get_last_fg_color()) + && (color = color_to_asciirgb(color)) + && (color = peColorStr(color,tmp_20k_buf)))) + color = "000000"; + + Tcl_SetResult(interp, color, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "background")){ + char *color; + + if(!((color = pico_get_last_bg_color()) + && (color = color_to_asciirgb(color)) + && (color = peColorStr(color,tmp_20k_buf)))) + color = "FFFFFF"; + + Tcl_SetResult(interp, color, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "flaglist")){ + int i; + char *p; + Tcl_Obj *itemObj; + + /* + * BUG: This list should get merged with the static list in "cmd_flag" + * and exported via some function similar to "feature_list()" + */ + static char *flag_list[] = { + "Important", "New", "Answered", "Deleted", NULL + }; + + /* + * CMD: flaglist + * + * Returns: list of FLAGS available for setting + */ + for(i = 0; (p = flag_list[i]); i++) + if((itemObj = Tcl_NewStringObj(p, -1)) != NULL){ + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + itemObj) != TCL_OK) + ; + } + + return(TCL_OK); + } + else if(!strcmp(s1, "featurelist")){ + int i; + char *curfeature, *s; + FEATURE_S *feature; + Tcl_Obj *itemObj, *secObj = NULL, *resObj = NULL; + + /* + * CMD: featurelist + * + * Returns: list of FEATURES available for setting + */ + for(i = 0, curfeature = NULL; (feature = feature_list(i)); i++) + if((s = feature_list_section(feature)) != NULL){ + if(!curfeature || strucmp(s, curfeature)){ + if(resObj) { + Tcl_ListObjAppendElement(interp, + secObj, + resObj); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + secObj); + } + + secObj = Tcl_NewListObj(0, NULL); + resObj = Tcl_NewListObj(0, NULL); + if(Tcl_ListObjAppendElement(interp, + secObj, + Tcl_NewStringObj(s,-1)) != TCL_OK) + ; + + curfeature = s; + } + + if((itemObj = Tcl_NewStringObj(feature->name, -1)) != NULL){ + if(Tcl_ListObjAppendElement(interp, + resObj, + itemObj) != TCL_OK) + ; + } + } + + if(resObj){ + Tcl_ListObjAppendElement(interp, secObj, resObj); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), secObj); + } + + return(TCL_OK); + } + else if(!strcmp(s1, "featuresettings")){ + int i; + FEATURE_S *feature; + Tcl_Obj *itemObj; + + /* + * CMD: featuresettings + * + * Returns: list of FEATURES currently SET + */ + for(i = 0; (feature = feature_list(i)); i++) + if(feature_list_section(feature)){ + if(F_ON(feature->id, ps_global)){ + if((itemObj = Tcl_NewStringObj(feature->name, -1)) != NULL){ + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + itemObj) != TCL_OK) + ; + } + } + } + + return(TCL_OK); + } + else if(!strcmp(s1, "signature")){ + char *sig; + + if((ps_global->VAR_LITERAL_SIG + || (ps_global->VAR_SIGNATURE_FILE + && IS_REMOTE(ps_global->VAR_SIGNATURE_FILE))) + && (sig = detoken(NULL, NULL, 2, 0, 1, NULL, NULL))){ + char *p, *q; + + for(p = sig; (q = strindex(p, '\n')); p = q + 1) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(p, q - p)); + + if(*p) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(p, -1)); + + fs_give((void **) &sig); + } + else + Tcl_SetResult(interp, "", TCL_STATIC); + + return(TCL_OK); + } + else if(!strcmp(s1, "rawsig")){ + char *err = NULL, *sig = NULL, *p, *q; + + if(ps_global->VAR_LITERAL_SIG){ + char *err = NULL; + char **apval; + + if(ps_global->restricted){ + err = "Alpine demo can't change config file"; + } + else{ + /* BUG: no "exceptions file" support */ + if((apval = APVAL(&ps_global->vars[V_LITERAL_SIG], Main)) != NULL){ + sig = (char *) fs_get((strlen(*apval ? *apval : "") + 1) * sizeof(char)); + sig[0] = '\0'; + cstring_to_string(*apval, sig); + } + else + err = "Problem accessing configuration"; + } + } + else if(!IS_REMOTE(ps_global->VAR_SIGNATURE_FILE)) + snprintf(err = tmp_20k_buf, SIZEOF_20KBUF, "Non-Remote signature file: %s", + ps_global->VAR_SIGNATURE_FILE ? ps_global->VAR_SIGNATURE_FILE : "<null>"); + else if(!(sig = simple_read_remote_file(ps_global->VAR_SIGNATURE_FILE, REMOTE_SIG_SUBTYPE))) + err = "Can't read remote pinerc"; + + if(err){ + Tcl_SetResult(interp, err, TCL_VOLATILE); + return(TCL_ERROR); + } + + for(p = sig; (q = strindex(p, '\n')); p = q + 1) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(p, q - p)); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(p, -1)); + fs_give((void **) &sig); + return(TCL_OK); + } + else if(!strcmp(s1, "statmsg")){ + char *s = sml_getmsg(); + /* BUG: can this be removed? */ + + Tcl_SetResult(interp, s ? s : "", TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "statmsgs")){ + char **s = sml_getmsgs(); + char **tmps, *lmsg = NULL; + + for(tmps = s; tmps && *tmps; lmsg = *tmps++) + if(!lmsg || strcmp(lmsg, *tmps)) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(*tmps, -1)); + + fs_give((void **)&s); + return(TCL_OK); + } + else if(!strcmp(s1, "saveconf")){ + write_pinerc(ps_global, Main, WRP_NOUSER); + return(TCL_OK); + } + else if(!strucmp(s1, "sort")){ + return(peAppendDefaultSort(interp)); + } + else if(!strcmp(s1, "ldapenabled")){ + /* + * CMD: ldapenabled + * + * Returns: 1 if enabled 0 if not + */ +#ifdef ENABLE_LDAP + Tcl_SetResult(interp, "1", TCL_VOLATILE); +#else + Tcl_SetResult(interp, "0", TCL_VOLATILE); +#endif + + return(TCL_OK); + } + else if(!strcmp(s1, "prunecheck")){ + time_t now; + struct tm *tm_now; + char tmp[50]; + + if(!check_prune_time(&now, &tm_now)){ + Tcl_SetResult(interp, "0", TCL_VOLATILE); + return(TCL_OK); + } else { + /* + * We're going to reset the last-time-pruned variable + * so that it asks a maximum of 1 time per month. + * PROs: Annoying-factor is at its lowest + * Can go ahead and move folders right away if + * pruning-rule is automatically set to do so + * CONs: Annoying-factor is at its lowest, if it's set + * later then we can ensure that the questions + * actually get answered or it will keep asking + */ + ps_global->last_expire_year = tm_now->tm_year; + ps_global->last_expire_month = tm_now->tm_mon; + snprintf(tmp, sizeof(tmp), "%d.%d", ps_global->last_expire_year, + ps_global->last_expire_month + 1); + set_variable(V_LAST_TIME_PRUNE_QUESTION, tmp, 0, 1, Main); + + Tcl_SetResult(interp, "1", TCL_VOLATILE); + } + return(TCL_OK); + } + else if(!strcmp(s1, "prunetime")){ + time_t now; + struct tm *tm_now; + CONTEXT_S *prune_cntxt; + Tcl_Obj *retObj = NULL; + int cur_month, ok = 1; + char **p; + static int moved_fldrs = 0; + + now = time((time_t *)0); + tm_now = localtime(&now); + cur_month = (1900 + tm_now->tm_year) * 12 + tm_now->tm_mon; + + if(!(prune_cntxt = default_save_context(ps_global->context_list))) + prune_cntxt = ps_global->context_list; + + if(prune_cntxt){ + if(ps_global->VAR_DEFAULT_FCC && *ps_global->VAR_DEFAULT_FCC + && context_isambig(ps_global->VAR_DEFAULT_FCC)) + if((retObj = wp_prune_folders(prune_cntxt, + ps_global->VAR_DEFAULT_FCC, + cur_month, "sent", + ps_global->pruning_rule, &ok, + moved_fldrs, interp)) != NULL) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + retObj); + + if(ok && ps_global->VAR_READ_MESSAGE_FOLDER + && *ps_global->VAR_READ_MESSAGE_FOLDER + && context_isambig(ps_global->VAR_READ_MESSAGE_FOLDER)) + if((retObj = wp_prune_folders(prune_cntxt, + ps_global->VAR_READ_MESSAGE_FOLDER, + cur_month, "read", + ps_global->pruning_rule, &ok, + moved_fldrs, interp)) != NULL) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + retObj); + if(ok && (p = ps_global->VAR_PRUNED_FOLDERS)){ + for(; ok && *p; p++) + if(**p && context_isambig(*p)) + if((retObj = wp_prune_folders(prune_cntxt, + *p, cur_month, "", + ps_global->pruning_rule, &ok, + moved_fldrs, interp)) != NULL) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + retObj); + } + } + moved_fldrs = 1; + return(TCL_OK); + } + else if(!strcmp(s1, "authrequestor")){ + Tcl_SetResult(interp, peCredentialRequestor, TCL_STATIC); + return(TCL_OK); + } + else if(!strcmp(s1, "noop")){ + /* tickle the imap server too */ + if(ps_global->mail_stream) + pine_mail_ping(ps_global->mail_stream); + + Tcl_SetResult(interp, "NOOP", TCL_STATIC); + return(TCL_OK); + } + else if(!strcmp(s1, "inputtimeout")){ + Tcl_SetResult(interp, int2string(get_input_timeout()), TCL_VOLATILE); + return(TCL_OK); + } + } + else if(objc == 3){ + if(!strcmp(s1, "feature")){ + char *featurename; + int i, isset = 0; + FEATURE_S *feature; + + /* + * CMD: feature + * + * ARGS: featurename - + * + * Returns: 1 if named feature set, 0 otherwise + * + */ + if((featurename = Tcl_GetStringFromObj(objv[2], NULL)) != NULL) + for(i = 0; (feature = feature_list(i)); i++) + if(!strucmp(featurename, feature->name)){ + isset = F_ON(feature->id, ps_global); + break; + } + + Tcl_SetResult(interp, int2string(isset), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "colorget")){ + char *varname; + char tvname[256], hexcolor[256]; + struct variable *vtmp; + if(!(varname = Tcl_GetStringFromObj(objv[2], NULL))){ + return(TCL_ERROR); + } + if(strcmp("viewer-hdr-colors", varname) == 0){ + SPEC_COLOR_S *hcolors, *thc; + Tcl_Obj *resObj; + char hexcolor[256], *tstr = NULL; + + hcolors = spec_colors_from_varlist(ps_global->VAR_VIEW_HDR_COLORS, 0); + for(thc = hcolors; thc; thc = thc->next){ + resObj = Tcl_NewListObj(0,NULL); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(thc->spec, -1)); + hex_colorstr(hexcolor, thc->fg); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(hexcolor, -1)); + hex_colorstr(hexcolor, thc->bg); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(hexcolor, -1)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(thc->val + ? tstr = pattern_to_string(thc->val) + : "", -1)); + if(tstr) fs_give((void **)&tstr); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + resObj); + } + fs_give((void **)&hcolors); + return(TCL_OK); + } + else { + snprintf(tvname, sizeof(tvname), "%.200s%.50s", varname, "-foreground-color"); + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++); + if(!vtmp->name) return(TCL_ERROR); + if(vtmp->is_list) return(TCL_ERROR); + if(!vtmp->current_val.p) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj("", -1)); + else{ + hex_colorstr(hexcolor, vtmp->current_val.p); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(hexcolor, -1)); + } + snprintf(tvname, sizeof(tvname), "%.200s%.50s", varname, "-background-color"); + vtmp++; + if((vtmp->name && strucmp(vtmp->name, tvname)) || !vtmp->name) + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++) + ; + + if(!vtmp->name) return(TCL_ERROR); + if(vtmp->is_list) return(TCL_ERROR); + if(!vtmp->current_val.p) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj("", -1)); + else{ + hex_colorstr(hexcolor, vtmp->current_val.p); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(hexcolor, -1)); + } + } + return(TCL_OK); + } + else if(!strcmp(s1, "varget")){ + struct variable *vtmp; + Tcl_Obj *itemObj, *resObj, *secObj; + char *vallist, *varname, tmperrmsg[256]; + int i; + NAMEVAL_S *tmpnv; + + /* + * CMD: varget + * + * Returns: get the values for the requested variable + * + * The list returned follows this general form: + * + * char *; variable name + * char **; list of set values + * char *; display type (listbox, text, textarea, ...) + * char **; list of possible values + * (so far this is only useful for listboxes) + */ + if(!(varname = Tcl_GetStringFromObj(objv[2], NULL))){ + Tcl_SetResult(interp, "Can't Tcl_GetStringFromObj", + TCL_VOLATILE); + return(TCL_ERROR); + } + + for(vtmp = ps_global->vars; + vtmp->name && strucmp(vtmp->name, varname); + vtmp++) + ; + + if(!vtmp->name){ + snprintf(tmperrmsg, sizeof(tmperrmsg), "Can't find variable named %s", + strlen(varname) < 200 ? varname : ""); + Tcl_SetResult(interp, tmperrmsg, TCL_VOLATILE); + return(TCL_ERROR); + } + if((itemObj = Tcl_NewStringObj(vtmp->name, -1)) != NULL){ + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + itemObj); + resObj = Tcl_NewListObj(0, NULL); + if(vtmp->is_list){ + for(i = 0 ; vtmp->current_val.l && vtmp->current_val.l[i]; i++){ + vallist = vtmp->current_val.l[i]; + if(*(vallist)) + itemObj = Tcl_NewStringObj(vallist, -1); + else + itemObj = Tcl_NewStringObj("", -1); + Tcl_ListObjAppendElement(interp, resObj, itemObj); + } + } + else{ + itemObj = Tcl_NewStringObj(vtmp->current_val.p ? + vtmp->current_val.p : "", -1); + Tcl_ListObjAppendElement(interp, resObj, itemObj); + } + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + resObj); + secObj = Tcl_NewListObj(0, NULL); + if(vtmp->is_list) + itemObj = Tcl_NewStringObj("textarea", -1); + else{ + NAMEVAL_S *(*tmpf)(int); + switch(vtmp - ps_global->vars){ + case V_SAVED_MSG_NAME_RULE: + tmpf = save_msg_rules; + break; + case V_FCC_RULE: + tmpf = fcc_rules; + break; + case V_SORT_KEY: + tmpf = sort_key_rules; + break; + case V_AB_SORT_RULE: + tmpf = ab_sort_rules; + break; + case V_FLD_SORT_RULE: + tmpf = fld_sort_rules; + break; + case V_GOTO_DEFAULT_RULE: + tmpf = goto_rules; + break; + case V_INCOMING_STARTUP: + tmpf = incoming_startup_rules; + break; + case V_PRUNING_RULE: + tmpf = pruning_rules; + break; + case V_WP_INDEXHEIGHT: + tmpf = wp_indexheight_rules; + break; + default: + tmpf = NULL; + break; + } + if(tmpf){ + for(i = 0; (tmpnv = (tmpf)(i)); i++){ + itemObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, itemObj, + Tcl_NewStringObj(tmpnv->name, -1)); + if(tmpnv->shortname) + Tcl_ListObjAppendElement(interp, itemObj, + Tcl_NewStringObj(tmpnv->shortname, -1)); + Tcl_ListObjAppendElement(interp, secObj, itemObj); + } + itemObj = Tcl_NewStringObj("listbox", -1); + } + else + itemObj = Tcl_NewStringObj("text", -1); + } + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + itemObj); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + secObj); + } + return(TCL_OK); + } + else if(!strcmp(s1, "rawsig")){ + + if(ps_global->VAR_LITERAL_SIG){ + char *cstring_version, *sig, *line; + int i, nSig; + Tcl_Obj **objSig; + + tmp_20k_buf[0] = '\0'; + Tcl_ListObjGetElements(interp, objv[2], &nSig, &objSig); + for(i = 0; i < nSig && i < SIG_MAX_LINES; i++) + if((line = Tcl_GetStringFromObj(objSig[i], NULL)) != NULL) + snprintf(tmp_20k_buf + strlen(tmp_20k_buf), SIZEOF_20KBUF - strlen(tmp_20k_buf), "%.*s\n", SIG_MAX_COLS, line); + + sig = cpystr(tmp_20k_buf); + + if((cstring_version = string_to_cstring(sig)) != NULL){ + set_variable(V_LITERAL_SIG, cstring_version, 0, 0, Main); + fs_give((void **)&cstring_version); + } + + fs_give((void **) &sig); + return(TCL_OK); + } + else + return(peWriteSig(interp, ps_global->VAR_SIGNATURE_FILE, + &((Tcl_Obj **)objv)[2])); + } + else if(!strcmp(s1, "statmsg")){ + char *msg; + + /* + * CMD: statmsg + * + * ARGS: msg - text to set + * + * Returns: nothing, but with global status message + * buf set to given msg + * + */ + if((msg = Tcl_GetStringFromObj(objv[2], NULL)) != NULL) + sml_addmsg(0, msg); + + return(TCL_OK); + } + else if(!strcmp(s1, "mode")){ + char *mode; + int rv = 0; + + /* + * CMD: mode + * + * ARGS: <mode> + * + * Returns: return value of given binary mode + * + */ + if((mode = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(!strcmp(mode, "full-header-mode")) + rv = ps_global->full_header; + } + + Tcl_SetResult(interp, int2string(rv), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "indexlines")){ + int n; + char *p; + + if(Tcl_GetIntFromObj(interp, objv[2], &n) == TCL_OK){ + set_variable(V_WP_INDEXLINES, p = int2string(n), 0, 0, Main); + Tcl_SetResult(interp, p, TCL_VOLATILE); + } + return(TCL_OK); + } + else if(!strcmp(s1, "aggtabstate")){ + int n; + char *p; + + if(Tcl_GetIntFromObj(interp, objv[2], &n) == TCL_OK){ + set_variable(V_WP_AGGSTATE, p = int2string(n), 0, 0, Main); + Tcl_SetResult(interp, p, TCL_VOLATILE); + } + return(TCL_OK); + } + else if(!strcmp(s1, "alpinestate")){ + char *wps, *p, *q, *twps = NULL; + int dollars = 0; + + if((wps = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + for(p = wps; *p; p++) + if(*p == '$') + dollars++; + + if(dollars){ + twps = (char *) fs_get(((p - wps) + (dollars + 1)) * sizeof(char)); + p = wps; + q = twps; + do{ + if(*p == '$') + *q++ = '\\'; + } + while((*q++ = *p++) != '\0'); + } + + set_variable(V_WP_STATE, twps ? twps : wps, 0, 1, Main); + Tcl_SetResult(interp, wps, TCL_VOLATILE); + if(twps) + fs_give((void **) &twps); + } + + return(TCL_OK); + } + else if(!strcmp(s1, "set")){ + Tcl_Obj *rObj; + + if((rObj = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG)) != NULL){ + Tcl_SetObjResult(interp, rObj); + return(TCL_OK); + } + else + return(TCL_ERROR); + } + else if(!strcmp(s1, "unset")){ + char *varname; + + return((varname = Tcl_GetStringFromObj(objv[2], NULL)) ? Tcl_UnsetVar2(interp, varname, NULL, TCL_LEAVE_ERR_MSG) : TCL_ERROR); + } + } + else if(objc == 4){ + if(!strcmp(s1, "feature")){ + char *featurename; + int i, set, wasset = 0; + FEATURE_S *feature; + + /* + * CMD: feature + * + * ARGS: featurename - + * value - new value to assign flag + * + * Returns: 1 if named feature set, 0 otherwise + * + */ + if((featurename = Tcl_GetStringFromObj(objv[2], NULL)) + && Tcl_GetIntFromObj(interp, objv[3], &set) != TCL_ERROR) + for(i = 0; (feature = feature_list(i)); i++) + if(!strucmp(featurename, feature->name)){ + if(set != F_ON(feature->id, ps_global)){ + toggle_feature(ps_global, + &ps_global->vars[V_FEATURE_LIST], + feature, TRUE, Main); + + if(ps_global->prc) + ps_global->prc->outstanding_pinerc_changes = 1; + } + + break; + } + + Tcl_SetResult(interp, int2string(wasset), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strucmp(s1, "help")){ + HelpType text; + int i; + char **help_text, **ptext, *helpname, tmperrmsg[256], + *function; + Tcl_Obj *itemObj; + struct variable *vtmp; + FEATURE_S *ftmp; + + if(!(helpname = Tcl_GetStringFromObj(objv[2], NULL))){ + Tcl_SetResult(interp, + "Can't Tcl_GetStringFromObj for helpname", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(!(function = Tcl_GetStringFromObj(objv[3], NULL))){ + Tcl_SetResult(interp, + "Can't Tcl_GetStringFromObj for function", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(strucmp(function, "plain") == 0){ + if((text = help_name2section(helpname, strlen(helpname))) + == NO_HELP) + return(TCL_OK); + } + else if(strucmp(function, "variable") == 0){ + for(vtmp = ps_global->vars; + vtmp->name && strucmp(vtmp->name, helpname); + vtmp++); + if(!vtmp->name) { + snprintf(tmperrmsg, sizeof(tmperrmsg), "Can't find variable named %s", + strlen(helpname) < 200 ? helpname : ""); + Tcl_SetResult(interp, tmperrmsg, TCL_VOLATILE); + return(TCL_ERROR); + } + text = config_help(vtmp - ps_global->vars, 0); + if(text == NO_HELP) + return(TCL_OK); + } + else if(strucmp(function, "feature") == 0){ + for(i = 0; (ftmp = feature_list(i)); i++){ + if(!strucmp(helpname, ftmp->name)){ + text = ftmp->help; + break; + } + } + if(!ftmp || text == NO_HELP){ + return(TCL_OK); + } + } + else { + snprintf(tmperrmsg, sizeof(tmperrmsg), "Invalid function: %s", + strlen(helpname) < 200 ? function : ""); + Tcl_SetResult(interp, tmperrmsg, TCL_VOLATILE); + return(TCL_ERROR); + } + /* assumption here is that HelpType is char ** */ + help_text = text; + for(ptext = help_text; *ptext; ptext++){ + itemObj = Tcl_NewStringObj(*ptext, -1); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + itemObj); + } + return(TCL_OK); + } + else if(!strcmp(s1, "varset")){ + char *varname, **tmpstrlist, *line; + struct variable *vtmp; + Tcl_Obj **objVal; + int i, numlistvals = 0, strlistpos; + + if((varname = Tcl_GetStringFromObj(objv[2], NULL)) + && (Tcl_ListObjGetElements(interp, objv[3], &numlistvals, + &objVal) == TCL_OK)){ + for(vtmp = ps_global->vars; + vtmp->name && strucmp(vtmp->name, varname); + vtmp++); + if(!vtmp->name){ + return(TCL_ERROR); + } + else{ + /* found the variable */ + if(vtmp->is_list){ + for(i = 0; vtmp->main_user_val.l && vtmp->main_user_val.l[i]; i++) + fs_give((void **)&vtmp->main_user_val.l[i]); + if(vtmp->main_user_val.l) + fs_give((void **)&vtmp->main_user_val.l); + if(numlistvals > 0){ + tmpstrlist = (char **)fs_get((numlistvals + 1) * sizeof(char *)); + for(i = 0, strlistpos = 0; i < numlistvals; i++){ + if((line = Tcl_GetStringFromObj(objVal[i], 0)) != NULL){ + removing_leading_and_trailing_white_space(line); + if(*line) + tmpstrlist[strlistpos++] = cpystr(line); + } + } + tmpstrlist[strlistpos] = NULL; + vtmp->main_user_val.l = (char **)fs_get((strlistpos+1) * + sizeof(char *)); + for(i = 0; i <= strlistpos; i++) + vtmp->main_user_val.l[i] = tmpstrlist[i]; + fs_give((void **)&tmpstrlist); + } + set_current_val(vtmp, FALSE, FALSE); + return(TCL_OK); + } + else{ + if((line = Tcl_GetStringFromObj(objVal[0], NULL)) != NULL){ + if(strucmp(vtmp->name, "reply-indent-string")) + removing_leading_and_trailing_white_space(line); + if(vtmp->main_user_val.p) + fs_give((void **)&vtmp->main_user_val.p); + if(*line) + vtmp->main_user_val.p = cpystr(line); + set_current_val(vtmp, FALSE, FALSE); + return(TCL_OK); + } + } + } + } + return(TCL_ERROR); + } + else if(!strcmp(s1, "mode")){ + char *mode; + int value, rv = 0; + + /* + * CMD: mode + * + * ARGS: <mode> <value> + * + * Returns: old value of binary mode we were told to set + * + */ + if((mode = Tcl_GetStringFromObj(objv[2], NULL)) + && Tcl_GetIntFromObj(interp, objv[3], &value) != TCL_ERROR){ + if(!strcmp(mode, "full-header-mode")){ + rv = ps_global->full_header; + ps_global->full_header = value; + } + } + + Tcl_SetResult(interp, int2string(rv), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "set")){ + Tcl_Obj *rObj; + + if((rObj = Tcl_ObjSetVar2(interp, objv[2], NULL, objv[3], TCL_LEAVE_ERR_MSG)) != NULL){ + Tcl_SetObjResult(interp, rObj); + return(TCL_OK); + } + else + return(TCL_ERROR); + } + } + else + err = "PEInfo: Too many arguments"; + } + } + + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + +/* + * PEConfigCmd - edit various alpine config variables + * + * The goal here is to remember what's changed, but not write to pinerc + * until the user's actually chosen to save. + */ +int +PEConfigCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *err = "Unknown PEConfig request"; + char *s1; + + dprint((2, "PEConfigCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); + } + s1 = Tcl_GetStringFromObj(objv[1], NULL); + + if(s1){ + if(!strcmp(s1, "colorset")){ + char *varname, *fghex, *bghex; + char tvname[256], asciicolor[256]; + struct variable *vtmp; + Tcl_Obj **cObj; + int cObjc; + SPEC_COLOR_S *hcolors, *thc; + + if(!(varname = Tcl_GetStringFromObj(objv[2], NULL))){ + Tcl_SetResult(interp, "colorset: can't read variable name", TCL_STATIC); + return(TCL_ERROR); + } + + if(!strcmp(varname, "viewer-hdr-colors")){ + char *newhdr = NULL, *newpat = NULL, *utype; + int hindex, i; + + if(objc < 5){ + Tcl_SetResult(interp, "colorset: too few view-hdr args", TCL_STATIC); + return(TCL_ERROR); + } + + if(ps_global->vars[V_VIEW_HDR_COLORS].is_changed_val) + hcolors = spec_colors_from_varlist(ps_global->vars[V_VIEW_HDR_COLORS].changed_val.l, 0); + else + hcolors = spec_colors_from_varlist(ps_global->VAR_VIEW_HDR_COLORS, 0); + if(!(utype = Tcl_GetStringFromObj(objv[3], NULL))){ + Tcl_SetResult(interp, "colorset: can't read operation", TCL_STATIC); + return(TCL_ERROR); + } + + if(!strcmp(utype, "delete")){ + if(!hcolors){ + Tcl_SetResult(interp, "colorset: no viewer-hdrs to delete", TCL_STATIC); + return(TCL_ERROR); + } + + if(Tcl_GetIntFromObj(interp, objv[4], &hindex) == TCL_ERROR){ + Tcl_SetResult(interp, "colorset: can't read index", TCL_STATIC); + return(TCL_ERROR); + } + + if(hindex == 0){ + thc = hcolors; + hcolors = hcolors->next; + thc->next = NULL; + free_spec_colors(&thc); + } + else{ + /* zero based */ + for(thc = hcolors, i = 1; thc && i < hindex; thc = thc->next, i++) + ; + + if(thc && thc->next){ + SPEC_COLOR_S *thc2 = thc->next; + + thc->next = thc2->next; + thc2->next = NULL; + free_spec_colors(&thc2); + } + else{ + Tcl_SetResult(interp, "colorset: invalid index", TCL_STATIC); + return(TCL_ERROR); + } + } + } + else if(!strcmp(utype, "add")){ + if(objc != 6){ + Tcl_SetResult(interp, "colorset: wrong number of view-hdr add args", TCL_STATIC); + return(TCL_ERROR); + } + + if(Tcl_ListObjGetElements(interp, objv[4], &cObjc, &cObj) != TCL_OK) + return (TCL_ERROR); + + if(cObjc != 2){ + Tcl_SetResult(interp, "colorset: wrong number of hdrs for view-hdr add", TCL_STATIC); + return(TCL_ERROR); + } + + newhdr = Tcl_GetStringFromObj(cObj[0], NULL); + newpat = Tcl_GetStringFromObj(cObj[1], NULL); + if(Tcl_ListObjGetElements(interp, objv[5], &cObjc, &cObj) != TCL_OK) + return (TCL_ERROR); + + if(cObjc != 2){ + Tcl_SetResult(interp, "colorset: wrong number of colors for view-hdr add", TCL_STATIC); + return(TCL_ERROR); + } + + fghex = Tcl_GetStringFromObj(cObj[0], NULL); + bghex = Tcl_GetStringFromObj(cObj[1], NULL); + if(newhdr && newpat && fghex && bghex){ + SPEC_COLOR_S **hcp; + + for(hcp = &hcolors; *hcp != NULL; hcp = &(*hcp)->next) + ; + + *hcp = (SPEC_COLOR_S *)fs_get(sizeof(SPEC_COLOR_S)); + (*hcp)->inherit = 0; + (*hcp)->spec = cpystr(newhdr); + (*hcp)->fg = cpystr((ascii_colorstr(asciicolor, fghex) == 0) ? asciicolor : "black"); + (*hcp)->bg = cpystr((ascii_colorstr(asciicolor, bghex) == 0) ? asciicolor : "white"); + + if(newpat && *newpat) + (*hcp)->val = string_to_pattern(newpat); + else + (*hcp)->val = NULL; + + (*hcp)->next = NULL; + } + else{ + Tcl_SetResult(interp, "colorset: invalid args for view-hdr add", TCL_STATIC); + return(TCL_ERROR); + } + } + else if(!strcmp(utype, "update")){ + if(objc != 6){ + Tcl_SetResult(interp, "colorset: wrong number of view-hdr update args", TCL_STATIC); + return(TCL_ERROR); + } + + if(!(Tcl_ListObjGetElements(interp, objv[4], &cObjc, &cObj) == TCL_OK + && cObjc == 3 + && Tcl_GetIntFromObj(interp, cObj[0], &hindex) == TCL_OK + && (newhdr = Tcl_GetStringFromObj(cObj[1], NULL)) + && (newpat = Tcl_GetStringFromObj(cObj[2], NULL)))){ + Tcl_SetResult(interp, "colorset: view-hdr update can't read index or header", TCL_STATIC); + return (TCL_ERROR); + } + + if(!(Tcl_ListObjGetElements(interp, objv[5], &cObjc, &cObj) == TCL_OK + && cObjc == 2 + && (fghex = Tcl_GetStringFromObj(cObj[0], NULL)) + && (bghex = Tcl_GetStringFromObj(cObj[1], NULL)))){ + Tcl_SetResult(interp, "colorset: view-hdr update can't read colors", TCL_STATIC); + return (TCL_ERROR); + } + + for(thc = hcolors, i = 0; thc && i < hindex; thc = thc->next, i++) + ; + + if(!thc){ + Tcl_SetResult(interp, "colorset: view-hdr update invalid index", TCL_STATIC); + return (TCL_ERROR); + } + + if(thc->spec) + fs_give((void **)&thc->spec); + + thc->spec = cpystr(newhdr); + if(ascii_colorstr(asciicolor, fghex) == 0) { + if(thc->fg) + fs_give((void **)&thc->fg); + + thc->fg = cpystr(asciicolor); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid foreground color value %.100s", fghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(ascii_colorstr(asciicolor, bghex) == 0) { + if(thc->bg) + fs_give((void **)&thc->bg); + + thc->bg = cpystr(asciicolor); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background color value %.100s", bghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(thc->val) + fs_give((void **)&thc->val); + + if(newpat && *newpat){ + thc->val = string_to_pattern(newpat); + } + } + else{ + Tcl_SetResult(interp, "colorset: unknown operation", TCL_STATIC); + return(TCL_ERROR); + } + + vtmp = &ps_global->vars[V_VIEW_HDR_COLORS]; + for(i = 0; vtmp->changed_val.l && vtmp->changed_val.l[i]; i++) + fs_give((void **)&vtmp->changed_val.l[i]); + + if(vtmp->changed_val.l) + fs_give((void **)&vtmp->changed_val.l); + + vtmp->changed_val.l = varlist_from_spec_colors(hcolors); + vtmp->is_changed_val = 1; + free_spec_colors(&hcolors); + return(TCL_OK); + } + else { + if(objc != 4){ + Tcl_SetResult(interp, "colorset: Wrong number of args", TCL_STATIC); + return(TCL_ERROR); + } + + if(!(Tcl_ListObjGetElements(interp, objv[3], &cObjc, &cObj) == TCL_OK + && cObjc == 2 + && (fghex = Tcl_GetStringFromObj(cObj[0], NULL)) + && (bghex = Tcl_GetStringFromObj(cObj[1], NULL)))){ + Tcl_SetResult(interp, "colorset: Problem reading fore/back ground colors", TCL_STATIC); + return (TCL_ERROR); + } + + snprintf(tvname, sizeof(tvname), "%.200s-foreground-color", varname); + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++) + ; + + if(!vtmp->name || vtmp->is_list){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background var %.100s", varname); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(ascii_colorstr(asciicolor, fghex) == 0) { + if(vtmp->changed_val.p) + fs_give((void **)&vtmp->changed_val.p); + + vtmp->changed_val.p = cpystr(asciicolor); + vtmp->is_changed_val = 1; + + /* We need to handle this in the actual config setting + * if(!strucmp(varname, "normal")) + * pico_set_fg_color(asciicolor); + */ + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid color value %.100s", fghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + snprintf(tvname, sizeof(tvname), "%.200s%.50s", varname, "-background-color"); + vtmp++; + if((vtmp->name && strucmp(vtmp->name, tvname)) || !vtmp->name) + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++) + ; + + if(!vtmp->name || vtmp->is_list){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background var %.100s", varname); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(ascii_colorstr(asciicolor, bghex) == 0) { + if(vtmp->changed_val.p) + fs_give((void **)&vtmp->changed_val.p); + + vtmp->changed_val.p = cpystr(asciicolor); + vtmp->is_changed_val = 1; + /* again, we need to handle this when we actually set the variable + * if(!strucmp(varname, "normal")) + * pico_set_bg_color(asciicolor); + */ + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "colorset: invalid background color value %.100s", bghex); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + Tcl_SetResult(interp, "1", TCL_STATIC); + return(TCL_OK); + } + } + else if(!strcmp(s1, "ruleset")){ + return(peRuleSet(interp, &((Tcl_Obj **)objv)[2])); + } + else if(objc == 2){ + if(!strcmp(s1, "featuresettings")){ + struct variable *vtmp; + int i; + FEATURE_S *feature; + + vtmp = &ps_global->vars[V_FEATURE_LIST]; + for(i = 0; (feature = feature_list(i)); i++) + if(feature_list_section(feature)){ + if(vtmp->is_changed_val ? F_CH_ON(feature->id) + : F_ON(feature->id, ps_global)){ + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(feature->name, -1)); + } + } + return(TCL_OK); + } + else if(!strcmp(s1, "rawsig")){ + char *err = NULL, *sig = NULL, *p, *q; + int i; + struct variable *vtmp; + + vtmp = &ps_global->vars[V_LITERAL_SIG]; + if(vtmp->is_changed_val ? vtmp->changed_val.p + : ps_global->VAR_LITERAL_SIG){ + char *err = NULL; + char **apval; + + if(ps_global->restricted){ + err = "Alpine demo can't change config file"; + } + else{ + /* BUG: no "exceptions file" support */ + apval = (vtmp->is_changed_val ? &vtmp->changed_val.p + : APVAL(&ps_global->vars[V_LITERAL_SIG], Main)); + if(apval){ + sig = (char *) fs_get((strlen(*apval ? *apval : "") + 1) * sizeof(char)); + sig[0] = '\0'; + cstring_to_string(*apval, sig); + } + else + err = "Problem accessing configuration"; + } + } + else if((vtmp = &ps_global->vars[V_SIGNATURE_FILE]) + && !IS_REMOTE(vtmp->is_changed_val ? vtmp->changed_val.p + : ps_global->VAR_SIGNATURE_FILE)) + snprintf(err = tmp_20k_buf, SIZEOF_20KBUF, "Non-Remote signature file: %s", + vtmp->is_changed_val ? (vtmp->changed_val.p + ? vtmp->changed_val.p : "<null>") + : (ps_global->VAR_SIGNATURE_FILE + ? ps_global->VAR_SIGNATURE_FILE : "<null>")); + else if(!(peTSig || (sig = simple_read_remote_file(vtmp->is_changed_val + ? vtmp->changed_val.p + : ps_global->VAR_SIGNATURE_FILE, REMOTE_SIG_SUBTYPE)))) + err = "Can't read remote pinerc"; + + if(err){ + Tcl_SetResult(interp, err, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(peTSig){ + for(i = 0; peTSig[i]; i++) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(peTSig[i],-1)); + } + else { + for(p = sig; (q = strindex(p, '\n')); p = q + 1) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(p, q - p)); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(p, -1)); + fs_give((void **) &sig); + } + return(TCL_OK); + } + else if(!strcmp(s1, "filters")){ + long rflags = ROLE_DO_FILTER | PAT_USE_CHANGED; + PAT_STATE pstate; + PAT_S *pat; + + close_every_pattern(); + if(any_patterns(rflags, &pstate)){ + for(pat = first_pattern(&pstate); + pat; + pat = next_pattern(&pstate)){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(pat->patgrp->nick, -1)); + } + } + return(TCL_OK); + } + else if(!strcmp(s1, "scores")){ + long rflags = ROLE_DO_SCORES | PAT_USE_CHANGED; + PAT_STATE pstate; + PAT_S *pat; + + close_every_pattern(); + if(any_patterns(rflags, &pstate)){ + for(pat = first_pattern(&pstate); + pat; + pat = next_pattern(&pstate)){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(pat->patgrp->nick, -1)); + } + } + return(TCL_OK); + } + else if(!strcmp(s1, "indexcolors")){ + long rflags = ROLE_DO_INCOLS | PAT_USE_CHANGED; + PAT_STATE pstate; + PAT_S *pat; + + close_every_pattern(); + if(any_patterns(rflags, &pstate)){ + for(pat = first_pattern(&pstate); + pat; + pat = next_pattern(&pstate)){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(pat->patgrp->nick, -1)); + } + } + return(TCL_OK); + } + else if(!strcmp(s1, "collections")){ + struct variable *vtmp; + int i; + CONTEXT_S *new_ctxt; + + vtmp = &ps_global->vars[V_FOLDER_SPEC]; + for(i = 0; (vtmp->is_changed_val + ? vtmp->changed_val.l && vtmp->changed_val.l[i] + : vtmp->current_val.l && vtmp->current_val.l[i]); + i++){ + new_ctxt = new_context(vtmp->is_changed_val + ? vtmp->changed_val.l[i] + : vtmp->current_val.l[i], NULL); + peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", + new_ctxt->nickname + ? new_ctxt->nickname + : (new_ctxt->server + ? new_ctxt->server + : (new_ctxt->label + ? new_ctxt->label + : "Some Collection")), + new_ctxt->label ? new_ctxt->label : ""); + free_context(&new_ctxt); + } + vtmp = &ps_global->vars[V_NEWS_SPEC]; + for(i = 0; (vtmp->is_changed_val + ? vtmp->changed_val.l && vtmp->changed_val.l[i] + : vtmp->current_val.l && vtmp->current_val.l[i]); + i++){ + new_ctxt = new_context(vtmp->is_changed_val + ? vtmp->changed_val.l[i] + : vtmp->current_val.l[i], NULL); + peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", + new_ctxt->nickname + ? new_ctxt->nickname + : (new_ctxt->server + ? new_ctxt->server + : (new_ctxt->label + ? new_ctxt->label + : "Some Collection")), + new_ctxt->label ? new_ctxt->label : ""); + free_context(&new_ctxt); + } + + return(TCL_OK); + } + else if(!strcmp(s1, "newconf")){ + struct variable *vtmp; + int i; + FEATURE_S *feature; + + for(vtmp = ps_global->vars; vtmp->name; vtmp++) + vtmp->is_changed_val = 0; + + for(i = 0; (feature = feature_list(i)); i++) + F_CH_SET(feature->id, F_ON(feature->id, ps_global)); + + if(peTSig){ + for(i = 0; peTSig[i]; i++) + fs_give((void **)&peTSig[i]); + fs_give((void **)&peTSig); + } + + close_patterns(ROLE_DO_FILTER | ROLE_DO_INCOLS | ROLE_DO_SCORES | PAT_USE_CHANGED); + return(TCL_OK); + } + else if(!strcmp(s1, "saveconf")){ + struct variable *vtmp; + int i, did_change = 0, def_sort_rev; + FEATURE_S *feature; + + if(ps_global->vars[V_FEATURE_LIST].is_changed_val){ + ps_global->vars[V_FEATURE_LIST].is_changed_val = 0; + for(i = 0; (feature = feature_list(i)); i++) + if(feature_list_section(feature)){ + if(F_CH_ON(feature->id) != F_ON(feature->id, ps_global)){ + did_change = 1; + toggle_feature(ps_global, + &ps_global->vars[V_FEATURE_LIST], + feature, TRUE, Main); + } + } + } + + for(vtmp = ps_global->vars; vtmp->name; vtmp++){ + if(vtmp->is_changed_val + && (vtmp - ps_global->vars != V_FEATURE_LIST)){ + if(vtmp->is_list){ + for(i = 0; vtmp->main_user_val.l + && vtmp->main_user_val.l[i]; i++) + fs_give((void **)&vtmp->main_user_val.l[i]); + if(vtmp->main_user_val.l) + fs_give((void **)&vtmp->main_user_val.l); + vtmp->main_user_val.l = vtmp->changed_val.l; + vtmp->changed_val.l = NULL; + } + else { + if(vtmp->main_user_val.p) + fs_give((void **)&vtmp->main_user_val.p); + vtmp->main_user_val.p = vtmp->changed_val.p; + vtmp->changed_val.p = NULL; + } + set_current_val(vtmp, FALSE, FALSE); + vtmp->is_changed_val = 0; + did_change = 1; + switch (vtmp - ps_global->vars) { + case V_USER_DOMAIN: + init_hostname(ps_global); + case V_FOLDER_SPEC: + case V_NEWS_SPEC: + free_contexts(&ps_global->context_list); + init_folders(ps_global); + break; + case V_NORM_FORE_COLOR: + pico_set_fg_color(vtmp->current_val.p); + break; + case V_NORM_BACK_COLOR: + pico_set_bg_color(vtmp->current_val.p); + break; + case V_ADDRESSBOOK: + case V_GLOB_ADDRBOOK: +#ifdef ENABLE_LDAP + case V_LDAP_SERVERS: +#endif + case V_ABOOK_FORMATS: + addrbook_reset(); + case V_INDEX_FORMAT: + init_index_format(ps_global->VAR_INDEX_FORMAT, + &ps_global->index_disp_format); + clear_index_cache(sp_inbox_stream(), 0); + break; + case V_PAT_FILTS: + close_patterns(ROLE_DO_FILTER | PAT_USE_CURRENT); + role_process_filters(); + break; + case V_PAT_INCOLS: + close_patterns(ROLE_DO_INCOLS | PAT_USE_CURRENT); + clear_index_cache(sp_inbox_stream(), 0); + role_process_filters(); + break; + case V_PAT_SCORES: + close_patterns(ROLE_DO_SCORES | PAT_USE_CURRENT); + role_process_filters(); + break; + case V_DEFAULT_FCC: + case V_DEFAULT_SAVE_FOLDER: + init_save_defaults(); + break; + case V_SORT_KEY: + decode_sort(ps_global->VAR_SORT_KEY, &ps_global->def_sort, &def_sort_rev); + break; + case V_VIEW_HDR_COLORS : + set_custom_spec_colors(ps_global); + break; + case V_POST_CHAR_SET : + update_posting_charset(ps_global, 1); + break; + default: + break; + } + } + } + if(peTSig){ + peWriteSig(interp, ps_global->VAR_SIGNATURE_FILE, NULL); + } + if(did_change){ + if(write_pinerc(ps_global, Main, WRP_NOUSER) == 0) + q_status_message(SM_ORDER, 0, 3, "Configuration changes saved!"); + } + return(TCL_OK); + } + else if(!strcmp(s1, "columns")){ + Tcl_SetResult(interp, int2string(ps_global->ttyo->screen_cols), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "indextokens")){ + INDEX_PARSE_T *tok; + int i; + + for(i = 0; (tok = itoken(i)) != NULL; i++) + if(tok->what_for & FOR_INDEX) + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(tok->name, -1)); + + return(TCL_OK); + } + } + else if(objc == 3){ + if(!strcmp(s1, "varget")){ + char *varname = Tcl_GetStringFromObj(objv[2], NULL); + struct variable *vtmp; + Tcl_Obj *resObj, *secObj; + char *input_type; + int is_default, i; + NAMEVAL_S *tmpnv; + + if(varname == NULL) return(TCL_ERROR); + + for(vtmp = ps_global->vars; + vtmp->name && strucmp(vtmp->name, varname); + vtmp++) + ; + + if(!vtmp->name){ + Tcl_SetResult(interp, err, TCL_VOLATILE); + return(TCL_ERROR); + } + resObj = Tcl_NewListObj(0, NULL); + if(vtmp->is_list){ + if(vtmp->is_changed_val){ + for(i = 0; vtmp->changed_val.l && vtmp->changed_val.l[i]; i++){ + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(vtmp->changed_val.l[i], -1)); + } + } + else { + for(i = 0; vtmp->current_val.l && vtmp->current_val.l[i]; i++){ + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(vtmp->current_val.l[i], -1)); + } + } + } + else { + if(vtmp->is_changed_val){ + if(vtmp->changed_val.p) + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(vtmp->changed_val.p[0] + ? vtmp->changed_val.p + : "\"\"", -1)); + } + else { + if(vtmp->current_val.p) + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(vtmp->current_val.p[0] + ? vtmp->current_val.p + : "\"\"", -1)); + } + } + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + resObj); + secObj = Tcl_NewListObj(0, NULL); + if(vtmp->is_list) + input_type = cpystr("textarea"); + else{ + NAMEVAL_S *(*tmpf)(int); + switch(vtmp - ps_global->vars){ + case V_SAVED_MSG_NAME_RULE: + tmpf = save_msg_rules; + break; + case V_FCC_RULE: + tmpf = fcc_rules; + break; + case V_SORT_KEY: + tmpf = sort_key_rules; + break; + case V_AB_SORT_RULE: + tmpf = ab_sort_rules; + break; + case V_FLD_SORT_RULE: + tmpf = fld_sort_rules; + break; + case V_GOTO_DEFAULT_RULE: + tmpf = goto_rules; + break; + case V_INCOMING_STARTUP: + tmpf = incoming_startup_rules; + break; + case V_PRUNING_RULE: + tmpf = pruning_rules; + break; + case V_WP_INDEXHEIGHT: + tmpf = wp_indexheight_rules; + break; + default: + tmpf = NULL; + break; + } + if(tmpf){ + for(i = 0; (tmpnv = (tmpf)(i)); i++){ + if(tmpnv->shortname) + peAppListF(interp, secObj, "%s%s", tmpnv->name, tmpnv->shortname); + else + Tcl_ListObjAppendElement(interp, secObj, + Tcl_NewStringObj(tmpnv->name, -1)); + } + input_type = cpystr("listbox"); + } + else + input_type = cpystr("text"); + } + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(input_type, -1)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + secObj); + if(vtmp->is_list) + is_default = !vtmp->is_changed_val && !vtmp->main_user_val.l; + else + is_default = !vtmp->is_changed_val && !vtmp->main_user_val.p; + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewIntObj(is_default)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewIntObj(vtmp->is_fixed)); + return(TCL_OK); + } + else if(!strcmp(s1, "filtextended")){ + int fl, i; + long rflags = ROLE_DO_FILTER | PAT_USE_CHANGED; + PAT_STATE pstate; + PAT_S *pat; + Tcl_Obj *resObj = NULL, *tObj = NULL; + + if(Tcl_GetIntFromObj(interp, objv[2], &fl) == TCL_ERROR) + return(TCL_ERROR); + + close_every_pattern(); + if(any_patterns(rflags, &pstate)){ + for(pat = first_pattern(&pstate), i = 0; + pat && i != fl; + pat = next_pattern(&pstate), i++); + + if(!pat) + return(TCL_ERROR); + + /* append the pattern ID */ + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("id", -1)); + pePatAppendID(interp, tObj, pat); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + + /* append the pattern */ + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("pattern", -1)); + pePatAppendPattern(interp, tObj, pat); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + + /* now append the filter action */ + resObj = Tcl_NewListObj(0, NULL); + peAppListF(interp, resObj, "%s%i", "kill", pat->action->folder ? 0 : 1); + peAppListF(interp, resObj, "%s%p", "folder", pat->action->folder); + peAppListF(interp, resObj, "%s%i", "move_only_if_not_deleted", + pat->action->move_only_if_not_deleted); + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("filtaction", -1)); + Tcl_ListObjAppendElement(interp, tObj, resObj); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + } + else return(TCL_ERROR); + + return(TCL_OK); + } + else if(!strcmp(s1, "indexcolorextended")){ + int fl, i; + long rflags = ROLE_DO_INCOLS | PAT_USE_CHANGED; + PAT_STATE pstate; + PAT_S *pat; + Tcl_Obj *resObj = NULL, *tObj = NULL; + + if(Tcl_GetIntFromObj(interp, objv[2], &fl) == TCL_ERROR) + return(TCL_ERROR); + + close_every_pattern(); + if(any_patterns(rflags, &pstate)){ + for(pat = first_pattern(&pstate), i = 0; + pat && i != fl; + pat = next_pattern(&pstate), i++); + + if(!pat) + return(TCL_ERROR); + + /* append the pattern ID */ + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("id", -1)); + pePatAppendID(interp, tObj, pat); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + + /* append the pattern */ + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("pattern", -1)); + pePatAppendPattern(interp, tObj, pat); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + + /* now append the pattern colors */ + resObj = Tcl_NewListObj(0, NULL); + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("indexcolor", -1)); + if(pat->action->is_a_incol){ + char *color; + Tcl_Obj *colObj = Tcl_NewListObj(0, NULL); + + if(!(pat->action->incol + && pat->action->incol->fg + && pat->action->incol->fg[0] + && (color = color_to_asciirgb(pat->action->incol->fg)) + && (color = peColorStr(color,tmp_20k_buf)))) + color = ""; + + Tcl_ListObjAppendElement(interp, colObj, Tcl_NewStringObj(color, -1)); + + if(!(pat->action->incol + && pat->action->incol->bg + && pat->action->incol->bg[0] + && (color = color_to_asciirgb(pat->action->incol->bg)) + && (color = peColorStr(color,tmp_20k_buf)))) + color = ""; + + Tcl_ListObjAppendElement(interp, colObj, Tcl_NewStringObj(color, -1)); + Tcl_ListObjAppendElement(interp, tObj, colObj); + } + Tcl_ListObjAppendElement(interp, resObj, tObj); + + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("indexcolors", -1)); + Tcl_ListObjAppendElement(interp, tObj, resObj); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + } + else return(TCL_ERROR); + + return(TCL_OK); + } + else if(!strcmp(s1, "scoreextended")){ + int fl, i; + long rflags = ROLE_DO_SCORES | PAT_USE_CHANGED; + char *hdr = NULL; + PAT_STATE pstate; + PAT_S *pat; + Tcl_Obj *resObj = NULL, *tObj = NULL; + + if(Tcl_GetIntFromObj(interp, objv[2], &fl) == TCL_ERROR) + return(TCL_ERROR); + + close_every_pattern(); + if(any_patterns(rflags, &pstate)){ + for(pat = first_pattern(&pstate), i = 0; + pat && i != fl; + pat = next_pattern(&pstate), i++); + + if(!pat) + return(TCL_ERROR); + + /* append the pattern ID */ + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("id", -1)); + pePatAppendID(interp, tObj, pat); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + + /* append the pattern */ + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("pattern", -1)); + pePatAppendPattern(interp, tObj, pat); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + + /* now append the filter action */ + resObj = Tcl_NewListObj(0, NULL); + peAppListF(interp, resObj, "%s%l", "scoreval", pat->action->scoreval); + if(pat->action->scorevalhdrtok) + hdr = hdrtok_to_stringform(pat->action->scorevalhdrtok); + + peAppListF(interp, resObj, "%s%s", "scorehdr", hdr ? hdr : ""); + + if(hdr) + fs_give((void **) &hdr); + + tObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, tObj, Tcl_NewStringObj("scores", -1)); + Tcl_ListObjAppendElement(interp, tObj, resObj); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + } + else return(TCL_ERROR); + + return(TCL_OK); + } + else if(!strcmp(s1, "clextended")){ + int cl, i, j = 0, in_folder_spec = 0; + struct variable *vtmp; + char tpath[MAILTMPLEN], *p; + CONTEXT_S *ctxt; + + vtmp = &ps_global->vars[V_FOLDER_SPEC]; + if(Tcl_GetIntFromObj(interp, objv[2], &cl) == TCL_ERROR) + return(TCL_ERROR); + for(i = 0; i < cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l + && vtmp->changed_val.l[i]) + : (vtmp->current_val.l + && vtmp->current_val.l[i])); i++); + if(i == cl && (vtmp->is_changed_val + ? vtmp->changed_val.l && vtmp->changed_val.l[i] + : vtmp->current_val.l && vtmp->current_val.l[i])) + in_folder_spec = 1; + else { + vtmp = &ps_global->vars[V_NEWS_SPEC]; + for(j = 0; i + j < cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l + && vtmp->changed_val.l[j]) + : (vtmp->current_val.l + && vtmp->current_val.l[j])); j++); + } + if(in_folder_spec || (i + j == cl && (vtmp->is_changed_val + ? vtmp->changed_val.l && vtmp->changed_val.l[j] + : vtmp->current_val.l && vtmp->current_val.l[j]))){ + ctxt = new_context(vtmp->is_changed_val ? vtmp->changed_val.l[in_folder_spec ? i : j] + : vtmp->current_val.l[in_folder_spec ? i : j], NULL); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ctxt->nickname ? ctxt->nickname : "", -1)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ctxt->label ? ctxt->label : "", -1)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ctxt->server ? ctxt->server : "", -1)); + tpath[0] = '\0'; + if(ctxt->context){ + strncpy(tpath, (ctxt->context[0] == '{' + && (p = strchr(ctxt->context, '}'))) + ? ++p + : ctxt->context, sizeof(tpath)); + tpath[sizeof(tpath)-1] = '\0'; + if((p = strstr(tpath, "%s")) != NULL) + *p = '\0'; + } + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(tpath, -1)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ctxt->dir && ctxt->dir->view.user + ? ctxt->dir->view.user : "", -1)); + free_context(&ctxt); + + return(TCL_OK); + } + else + return(TCL_ERROR); + } + else if(!strcmp(s1, "rawsig")){ + struct variable *vtmp; + char *cstring_version, *sig, *line; + int i, nSig; + Tcl_Obj **objSig; + + vtmp = &ps_global->vars[V_LITERAL_SIG]; + if(vtmp->is_changed_val ? vtmp->changed_val.p + : ps_global->VAR_LITERAL_SIG){ + + tmp_20k_buf[0] = '\0'; + Tcl_ListObjGetElements(interp, objv[2], &nSig, &objSig); + for(i = 0; i < nSig && i < SIG_MAX_LINES; i++) + if((line = Tcl_GetStringFromObj(objSig[i], NULL)) != NULL) + snprintf(tmp_20k_buf + strlen(tmp_20k_buf), SIZEOF_20KBUF - strlen(tmp_20k_buf), "%.*s\n", SIG_MAX_COLS, line); + + sig = cpystr(tmp_20k_buf); + + if((cstring_version = string_to_cstring(sig)) != NULL){ + if(vtmp->changed_val.p) + fs_give((void **)&vtmp->changed_val.p); + vtmp->is_changed_val = 1; + vtmp->changed_val.p = cstring_version; + } + + fs_give((void **) &sig); + return(TCL_OK); + } + else { + if(peTSig){ + for(i = 0; peTSig[i]; i++) + fs_give((void **)&peTSig[i]); + fs_give((void **)&peTSig); + } + Tcl_ListObjGetElements(interp, objv[2], &nSig, &objSig); + peTSig = (char **)fs_get(sizeof(char)*(nSig + 1)); + for(i = 0; i < nSig; i++){ + line = Tcl_GetStringFromObj(objSig[i], NULL); + peTSig[i] = cpystr(line ? line : ""); + } + peTSig[i] = NULL; + return(TCL_OK); + } + } + else if(!strcmp(s1, "colorget")){ + char *varname; + char tvname[256], hexcolor[256]; + struct variable *vtmp; + if(!(varname = Tcl_GetStringFromObj(objv[2], NULL))){ + return(TCL_ERROR); + } + if(strcmp("viewer-hdr-colors", varname) == 0){ + SPEC_COLOR_S *hcolors, *thc; + Tcl_Obj *resObj; + char hexcolor[256], *tstr = NULL; + + if(ps_global->vars[V_VIEW_HDR_COLORS].is_changed_val) + hcolors = spec_colors_from_varlist(ps_global->vars[V_VIEW_HDR_COLORS].changed_val.l, 0); + else + hcolors = spec_colors_from_varlist(ps_global->VAR_VIEW_HDR_COLORS, 0); + for(thc = hcolors; thc; thc = thc->next){ + resObj = Tcl_NewListObj(0,NULL); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(thc->spec, -1)); + hex_colorstr(hexcolor, thc->fg); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(hexcolor, -1)); + hex_colorstr(hexcolor, thc->bg); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(hexcolor, -1)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(thc->val + ? tstr = pattern_to_string(thc->val) + : "", -1)); + if(tstr) fs_give((void **)&tstr); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + resObj); + } + fs_give((void **)&hcolors); + return(TCL_OK); + } + else { + char *colorp; + + snprintf(tvname, sizeof(tvname), "%.200s%.50s", varname, "-foreground-color"); + + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++) + ; + + if(!vtmp->name) return(TCL_ERROR); + if(vtmp->is_list) return(TCL_ERROR); + + colorp = (vtmp->is_changed_val && vtmp->changed_val.p) + ? vtmp->changed_val.p + : (vtmp->current_val.p) ? vtmp->current_val.p + : vtmp->global_val.p; + + if(colorp){ + hex_colorstr(hexcolor, colorp); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(hexcolor, -1)); + } + else + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj("", -1)); + + snprintf(tvname, sizeof(tvname), "%.200s%.50s", varname, "-background-color"); + vtmp++; + if((vtmp->name && strucmp(vtmp->name, tvname)) || !vtmp->name) + for(vtmp = &ps_global->vars[V_NORM_FORE_COLOR]; + vtmp->name && strucmp(vtmp->name, tvname); + vtmp++) + ; + + if(!vtmp->name) return(TCL_ERROR); + if(vtmp->is_list) return(TCL_ERROR); + + colorp = (vtmp->is_changed_val && vtmp->changed_val.p) + ? vtmp->changed_val.p + : (vtmp->current_val.p) ? vtmp->current_val.p + : vtmp->global_val.p; + + if(colorp){ + hex_colorstr(hexcolor, colorp); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(hexcolor, -1)); + } + else + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj("", -1)); + } + return(TCL_OK); + } + else if(!strcmp(s1, "cldel")){ + int cl, i, j, n; + struct variable *vtmp; + char **newl; + + if(Tcl_GetIntFromObj(interp, objv[2], &cl) == TCL_ERROR) + return(TCL_ERROR); + vtmp = &ps_global->vars[V_FOLDER_SPEC]; + for(i = 0; i < cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[i]) + : (vtmp->current_val.l && vtmp->current_val.l[i])); i++); + if(!(i == cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[i]) + : (vtmp->current_val.l && vtmp->current_val.l[i])))){ + vtmp = &ps_global->vars[V_NEWS_SPEC]; + for(j = 0; i + j < cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[j]) + : (vtmp->current_val.l && vtmp->current_val.l[j])); + j++); + if(!(vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[j]) + : (vtmp->current_val.l && vtmp->current_val.l[j]))) + return(TCL_ERROR); + i = j; + } + for(n = 0; vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[n]) + : (vtmp->current_val.l && vtmp->current_val.l[n]); n++); + newl = (char **)fs_get(n*(sizeof(char *))); + for(n = 0; vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[n]) + : (vtmp->current_val.l && vtmp->current_val.l[n]); n++){ + if(n < i) + newl[n] = cpystr(vtmp->is_changed_val ? vtmp->changed_val.l[n] + : vtmp->current_val.l[n]); + else if(n > i) + newl[n-1] = cpystr(vtmp->is_changed_val ? vtmp->changed_val.l[n] + : vtmp->current_val.l[n]); + } + newl[n-1] = NULL; + vtmp->is_changed_val = 1; + for(n = 0; vtmp->changed_val.l && vtmp->changed_val.l[n]; n++) + fs_give((void **) &vtmp->changed_val.l[n]); + if(vtmp->changed_val.l) fs_give((void **)&vtmp->changed_val.l); + vtmp->changed_val.l = newl; + + return(TCL_OK); + } + else if(!strcmp(s1, "columns")){ + int n; + char *p; + + if(Tcl_GetIntFromObj(interp, objv[2], &n) != TCL_ERROR + && n >= MIN_SCREEN_COLS + && n < (MAX_SCREEN_COLS - 1) + && ps_global->ttyo->screen_cols != n){ + clear_index_cache(sp_inbox_stream(), 0); + ps_global->ttyo->screen_cols = n; + set_variable(V_WP_COLUMNS, p = int2string(n), 0, 0, Main); + Tcl_SetResult(interp, p, TCL_VOLATILE); + } + else + Tcl_SetResult(interp, int2string(ps_global->ttyo->screen_cols), TCL_VOLATILE); + + return(TCL_OK); + } + else if(!strcmp(s1, "reset")){ + char *p; + + if((p = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(!strcmp(p,"pinerc")){ + struct variable *var; + PINERC_S *prc; + + /* new pinerc structure, copy location pointers */ + prc = new_pinerc_s(ps_global->prc->name); + prc->type = ps_global->prc->type; + prc->rd = ps_global->prc->rd; + prc->outstanding_pinerc_changes = 1; + + /* tie off original pinerc struct and free it */ + ps_global->prc->rd = NULL; + ps_global->prc->outstanding_pinerc_changes = 0; + free_pinerc_s(&ps_global->prc); + + /* set global->prc to new struct with no pinerc_lines + * and fool write_pinerc into not writing changed vars + */ + ps_global->prc = prc; + + /* + * write at least one var into nearly empty pinerc + * and clear user's var settings. clear global cause + * they'll get reset in peInitVars + */ + for(var = ps_global->vars; var->name != NULL; var++){ + var->been_written = ((var - ps_global->vars) != V_LAST_VERS_USED); + if(var->is_list){ + free_list_array(&var->main_user_val.l); + free_list_array(&var->global_val.l); + } + else{ + fs_give((void **)&var->main_user_val.p); + fs_give((void **)&var->global_val.p); + } + } + + write_pinerc(ps_global, Main, WRP_NOUSER | WRP_PRESERV_WRITTEN); + + peInitVars(ps_global); + return(TCL_OK); + } + } + } + } + else if(objc == 4){ + if(!strcmp(s1, "varset")){ + char *varname = Tcl_GetStringFromObj(objv[2], NULL); + struct variable *vtmp; + char **tstrlist = NULL, *line, *tline; + Tcl_Obj **objVal; + int i, strlistpos, numlistvals; + + if(varname == NULL) return(TCL_ERROR); + for(vtmp = ps_global->vars; + vtmp->name && strucmp(vtmp->name, varname); + vtmp++) + ; + if(!vtmp->name){ + Tcl_SetResult(interp, err, TCL_VOLATILE); + return(TCL_ERROR); + } + if(Tcl_ListObjGetElements(interp, objv[3], &numlistvals, + &objVal) != TCL_OK) + return(TCL_ERROR); + vtmp->is_changed_val = 1; + if(vtmp->is_list){ + if(vtmp->changed_val.l){ + for(i = 0; vtmp->changed_val.l[i]; i++) + fs_give((void **)&vtmp->changed_val.l[i]); + fs_give((void **)&vtmp->changed_val.l); + } + if(numlistvals) + tstrlist = (char **)fs_get((numlistvals + 1) * sizeof(char *)); + for(i = 0, strlistpos = 0; i < numlistvals; i++){ + if((line = Tcl_GetStringFromObj(objVal[i], 0)) != NULL){ + tline = cpystr(line); + removing_leading_and_trailing_white_space(tline); + if(*tline) + tstrlist[strlistpos++] = cpystr(tline); + fs_give((void **) &tline); + } + } + if(tstrlist) + tstrlist[strlistpos] = NULL; + vtmp->changed_val.l = tstrlist; + } + else { + if(vtmp->changed_val.p) + fs_give((void **)&vtmp->changed_val.p); + if(numlistvals){ + if((line = Tcl_GetStringFromObj(objVal[0], 0)) != NULL){ + tline = cpystr(line); + if(strucmp(vtmp->name, "reply-indent-string")) + removing_leading_and_trailing_white_space(tline); + if(!strcmp(tline, "\"\"")){ + tline[0] = '\0'; + } + else if(tline[0] == '\0'){ + fs_give((void **)&tline); + } + if(tline){ + vtmp->changed_val.p = cpystr(tline); + fs_give((void **)&tline); + } + } + else + vtmp->changed_val.p = cpystr(""); + } + } + return(TCL_OK); + } + else if(!strcmp(s1, "feature")){ + char *featurename; + int i, set, wasset = 0; + FEATURE_S *feature; + + /* + * CMD: feature + * + * ARGS: featurename - + * value - new value to assign flag + * + * Returns: 1 if named feature set, 0 otherwise + * + */ + if((featurename = Tcl_GetStringFromObj(objv[2], NULL)) + && Tcl_GetIntFromObj(interp, objv[3], &set) != TCL_ERROR) + for(i = 0; (feature = feature_list(i)); i++) + if(!strucmp(featurename, feature->name)){ + ps_global->vars[V_FEATURE_LIST].is_changed_val = 1; + wasset = F_CH_ON(feature->id); + F_CH_SET(feature->id, set); + break; + } + + Tcl_SetResult(interp, int2string(wasset), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "clshuff")){ + char *dir, *tstr, **newl; + int cl, up = 0, fvarn, nvarn, icnt, i; + struct variable *fvar, *nvar, *vtmp; + + if(!(dir = Tcl_GetStringFromObj(objv[2], NULL))) + return TCL_ERROR; + if(Tcl_GetIntFromObj(interp, objv[3], &cl) == TCL_ERROR) + return(TCL_ERROR); + if(!strcmp(dir, "up")) + up = 1; + else if(!strcmp(dir, "down")) + up = 0; + else + return(TCL_ERROR); + fvar = &ps_global->vars[V_FOLDER_SPEC]; + nvar = &ps_global->vars[V_NEWS_SPEC]; + for(fvarn = 0; fvar->is_changed_val ? (fvar->changed_val.l && fvar->changed_val.l[fvarn]) + : (fvar->current_val.l && fvar->current_val.l[fvarn]); fvarn++); + for(nvarn = 0; nvar->is_changed_val ? (nvar->changed_val.l && nvar->changed_val.l[nvarn]) + : (nvar->current_val.l && nvar->current_val.l[nvarn]); nvarn++); + if(cl < fvarn){ + vtmp = fvar; + icnt = cl; + } + else if(cl >= fvarn && cl < nvarn + fvarn){ + vtmp = nvar; + icnt = cl - fvarn; + } + else + return(TCL_ERROR); + if(vtmp == nvar && icnt == 0 && up){ + newl = (char **)fs_get((fvarn + 2)*sizeof(char *)); + for(i = 0; fvar->is_changed_val ? (fvar->changed_val.l && fvar->changed_val.l[i]) + : (fvar->current_val.l && fvar->current_val.l[i]); i++) + newl[i] = cpystr(fvar->is_changed_val ? fvar->changed_val.l[i] + : fvar->current_val.l[i]); + newl[i++] = cpystr(nvar->is_changed_val ? nvar->changed_val.l[0] + : nvar->current_val.l[0]); + newl[i] = NULL; + fvar->is_changed_val = 1; + for(i = 0; fvar->changed_val.l && fvar->changed_val.l[i]; i++) + fs_give((void **)&fvar->changed_val.l[i]); + if(fvar->changed_val.l) fs_give((void **)&fvar->changed_val.l); + fvar->changed_val.l = newl; + newl = (char **)fs_get(nvarn*sizeof(char *)); + for(i = 1; nvar->is_changed_val ? (nvar->changed_val.l && nvar->changed_val.l[i]) + : (nvar->current_val.l && nvar->current_val.l[i]); i++) + newl[i-1] = cpystr(nvar->is_changed_val ? nvar->changed_val.l[i] + : nvar->current_val.l[i]); + newl[i-1] = NULL; + nvar->is_changed_val = 1; + for(i = 0; nvar->changed_val.l && nvar->changed_val.l[i]; i++) + fs_give((void **)&nvar->changed_val.l[i]); + if(nvar->changed_val.l) fs_give((void **)&nvar->changed_val.l); + nvar->changed_val.l = newl; + vtmp = fvar; + icnt = fvarn; + } + else if(vtmp == fvar && icnt == fvarn - 1 && !up){ + newl = (char **)fs_get(fvarn*sizeof(char *)); + for(i = 0; fvar->is_changed_val ? (fvar->changed_val.l && fvar->changed_val.l[i+1]) + : (fvar->current_val.l && fvar->current_val.l[i+1]); i++) + newl[i] = cpystr(fvar->is_changed_val ? fvar->changed_val.l[i] + : fvar->current_val.l[i]); + newl[i] = NULL; + tstr = cpystr(fvar->is_changed_val ? fvar->changed_val.l[i] + : fvar->current_val.l[i]); + fvar->is_changed_val = 1; + for(i = 0; fvar->changed_val.l && fvar->changed_val.l[i]; i++) + fs_give((void **)&fvar->changed_val.l[i]); + if(fvar->changed_val.l) fs_give((void **)&fvar->changed_val.l); + fvar->changed_val.l = newl; + newl = (char **)fs_get((nvarn+2)*sizeof(char *)); + newl[0] = tstr; + for(i = 0; nvar->is_changed_val ? (nvar->changed_val.l && nvar->changed_val.l[i]) + : (nvar->current_val.l && nvar->current_val.l[i]); i++) + newl[i+1] = cpystr(nvar->is_changed_val ? nvar->changed_val.l[i] + : nvar->current_val.l[i]); + newl[i+1] = NULL; + nvar->is_changed_val = 1; + for(i = 0; nvar->changed_val.l && nvar->changed_val.l[i]; i++) + fs_give((void **)&nvar->changed_val.l[i]); + if(nvar->changed_val.l) fs_give((void **)&nvar->changed_val.l); + nvar->changed_val.l = newl; + vtmp = nvar; + icnt = 0; + } + else { + newl = (char **)fs_get(((vtmp == fvar ? fvarn : nvarn) + 1)*sizeof(char *)); + for(i = 0; vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[i]) + : (vtmp->current_val.l && vtmp->current_val.l[i]); i++) + newl[i] = cpystr(vtmp->is_changed_val ? vtmp->changed_val.l[i] + : vtmp->current_val.l[i]); + newl[i] = NULL; + vtmp->is_changed_val = 1; + for(i = 0; vtmp->changed_val.l && vtmp->changed_val.l[i]; i++) + fs_give((void **)&vtmp->changed_val.l[i]); + if(vtmp->changed_val.l) fs_give((void **)&vtmp->changed_val.l); + vtmp->changed_val.l = newl; + } + if(up){ + tstr = vtmp->changed_val.l[icnt-1]; + vtmp->changed_val.l[icnt-1] = vtmp->changed_val.l[icnt]; + vtmp->changed_val.l[icnt] = tstr; + } + else { + tstr = vtmp->changed_val.l[icnt+1]; + vtmp->changed_val.l[icnt+1] = vtmp->changed_val.l[icnt]; + vtmp->changed_val.l[icnt] = tstr; + } + return(TCL_OK); + } + } + else if(objc == 7){ + if(!strcmp(s1, "cledit") || !strcmp(s1, "cladd")){ + int add = 0, cl, quotes_needed = 0, i, j, newn; + char *nick, *server, *path, *view, context_buf[MAILTMPLEN*4]; + char **newl; + struct variable *vtmp; + + if(!strcmp(s1, "cladd")) add = 1; + + if(Tcl_GetIntFromObj(interp, objv[2], &cl) == TCL_ERROR) + return(TCL_ERROR); + if(!(nick = Tcl_GetStringFromObj(objv[3], NULL))) + return TCL_ERROR; + if(!(server = Tcl_GetStringFromObj(objv[4], NULL))) + return TCL_ERROR; + if(!(path = Tcl_GetStringFromObj(objv[5], NULL))) + return TCL_ERROR; + if(!(view = Tcl_GetStringFromObj(objv[6], NULL))) + return TCL_ERROR; + removing_leading_and_trailing_white_space(nick); + removing_leading_and_trailing_white_space(server); + removing_leading_and_trailing_white_space(path); + removing_leading_and_trailing_white_space(view); + if(strchr(nick, ' ')) + quotes_needed = 1; + if(strlen(nick)+strlen(server)+strlen(path)+strlen(view) > + MAILTMPLEN * 4 - 20) { /* for good measure */ + Tcl_SetResult(interp, "info too long", TCL_VOLATILE); + return TCL_ERROR; + } + if(3 + strlen(nick) + strlen(server) + strlen(path) + + strlen(view) > MAILTMPLEN + 4){ + Tcl_SetResult(interp, "collection fields too long", TCL_VOLATILE); + return(TCL_OK); + } + snprintf(context_buf, sizeof(context_buf), "%s%s%s%s%s%s[%s]", quotes_needed ? + "\"" : "", nick, quotes_needed ? "\"" : "", + strlen(nick) ? " " : "", + server, path, view); + if(add) { + vtmp = &ps_global->vars[V_NEWS_SPEC]; + if(!(vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[0]) + : (vtmp->current_val.l && vtmp->current_val.l[0]))) + vtmp = &ps_global->vars[V_FOLDER_SPEC]; + for(i = 0; vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[i]) + : (vtmp->current_val.l && vtmp->current_val.l[i]); i++); + newn = i + 1; + newl = (char **)fs_get((newn + 1)*sizeof(char *)); + for(i = 0; vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[i]) + : (vtmp->current_val.l && vtmp->current_val.l[i]); i++) + newl[i] = cpystr(vtmp->is_changed_val ? vtmp->changed_val.l[i] + : vtmp->current_val.l[i]); + newl[i++] = cpystr(context_buf); + newl[i] = NULL; + } + else { + vtmp = &ps_global->vars[V_FOLDER_SPEC]; + for(i = 0; i < cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[i]) + : (vtmp->current_val.l && vtmp->current_val.l[i])); i++); + if(!(i == cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[i]) + : (vtmp->current_val.l && vtmp->current_val.l[i])))){ + vtmp = &ps_global->vars[V_NEWS_SPEC]; + for(j = 0; i + j < cl && (vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[j]) + : (vtmp->current_val.l && vtmp->current_val.l[j])); + j++); + if(!(vtmp->is_changed_val + ? (vtmp->changed_val.l && vtmp->changed_val.l[j]) + : (vtmp->current_val.l && vtmp->current_val.l[j]))) + return(TCL_ERROR); + i = j; + } + for(j = 0; vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[j]) + : (vtmp->current_val.l && vtmp->current_val.l[j]); j++); + newl = (char **)fs_get(j * sizeof(char *)); + for(j = 0; vtmp->is_changed_val ? (vtmp->changed_val.l && vtmp->changed_val.l[j]) + : (vtmp->current_val.l && vtmp->current_val.l[j]); j++){ + if(j == i) + newl[j] = cpystr(context_buf); + else + newl[j] = cpystr(vtmp->is_changed_val ? vtmp->changed_val.l[j] + : vtmp->current_val.l[j]); + } + newl[j] = NULL; + } + vtmp->is_changed_val = 1; + for(j = 0; vtmp->changed_val.l && vtmp->changed_val.l[j]; j++) + fs_give((void **)&vtmp->changed_val.l[j]); + if(vtmp->changed_val.l) fs_give((void **)&vtmp->changed_val.l); + vtmp->changed_val.l = newl; + return TCL_OK; + } + } + else + err = "PEInfo: Too many arguments"; + } + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + +int +peWriteSig(Tcl_Interp *interp, char *file, Tcl_Obj **objv) +{ + int try_cache, e, i, n, nSig; + char datebuf[200], *sig, *line; + FILE *fp; + REMDATA_S *rd; + Tcl_Obj **objSig; + + if(!(file && IS_REMOTE(file))){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Non-Remote signature file: %s", + file ? file : "<null>"); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + /* + * We could parse the name here to find what type it is. So far we + * only have type RemImap. + */ + rd = rd_create_remote(RemImap, file, (void *)REMOTE_SIG_SUBTYPE, + NULL, "Error: ", "Can't fetch remote signature."); + if(!rd){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Can't create stream for sig file: %s", file); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + try_cache = rd_read_metadata(rd); + + if(rd->access == MaybeRorW){ + if(rd->read_status == 'R') + rd->access = ReadOnly; + else + rd->access = ReadWrite; + } + + if(rd->access != NoExists){ + + rd_check_remvalid(rd, 1L); + + /* + * If the cached info says it is readonly but + * it looks like it's been fixed now, change it to readwrite. + */ + if(rd->read_status == 'R'){ + /* + * We go to this trouble since readonly sigfiles + * are likely a mistake. They are usually supposed to be + * readwrite so we open it and check if it's been fixed. + */ + rd_check_readonly_access(rd); + if(rd->read_status == 'W'){ + rd->access = ReadWrite; + rd->flags |= REM_OUTOFDATE; + } + else{ + rd_close_remdata(&rd); + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Readonly sig file: %s", file); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + } + + if(rd->flags & REM_OUTOFDATE){ + if(rd_update_local(rd) != 0){ + + dprint((1, "pinerc_remote_open: rd_update_local failed")); + /* + * Don't give up altogether. We still may be + * able to use a cached copy. + */ + } + else{ + dprint((7, "%s: copied remote to local (%ld)", + rd->rn, (long)rd->last_use)); + } + } + + if(rd->access == ReadWrite) + rd->flags |= DO_REMTRIM; + } + + /* If we couldn't get to remote folder, try using the cached copy */ + if(rd->access == NoExists || rd->flags & REM_OUTOFDATE){ + rd_close_remdata(&rd); + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Unavailable sig file: %s", file); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + unlink(rd->lf); + + sig = NULL; + tmp_20k_buf[0] = '\0'; + if(objv){ + Tcl_ListObjGetElements(interp, objv[0], &nSig, &objSig); + for(i = 0; i < nSig && i < SIG_MAX_LINES; i++){ + if((line = Tcl_GetStringFromObj(objSig[i], NULL)) != NULL) + snprintf(tmp_20k_buf + strlen(tmp_20k_buf), SIZEOF_20KBUF - strlen(tmp_20k_buf), "%.*s\n", + SIG_MAX_COLS, line); + } + } + else if(peTSig){ + for(i = 0; peTSig[i] && i < SIG_MAX_LINES; i++) { + snprintf(tmp_20k_buf + strlen(tmp_20k_buf), SIZEOF_20KBUF - strlen(tmp_20k_buf), "%.*s\n", + SIG_MAX_COLS, peTSig[i]); + } + for(i = 0; peTSig[i]; i++) + fs_give((void **)&peTSig[i]); + fs_give((void **)&peTSig); + } + else + return(TCL_ERROR); + + sig = cpystr(tmp_20k_buf); + + if((fp = fopen(rd->lf, "w")) != NULL) + n = fwrite(sig, strlen(sig), 1, fp); + + fs_give((void **) &sig); + + if(fp){ + if(n != 1){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Sig copy failure1: %s: %s", + rd->lf, error_description(errno)); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + rd_close_remdata(&rd); + } + + fclose(fp); + if(n != 1) + return(TCL_ERROR); + } + else { + rd_close_remdata(&rd); + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Sig copy open failure2: %s: %s", + rd->lf, error_description(errno)); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + datebuf[0] = '\0'; + + if(!rd->t.i.stream){ + long retflags = 0; + + rd->t.i.stream = context_open(NULL, NULL, rd->rn, 0L, &retflags); + } + + if((e = rd_update_remote(rd, datebuf)) != 0){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Sig update failure: %s: %s", + rd->lf, error_description(errno)); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + rd_close_remdata(&rd); + return(TCL_ERROR); + } + + rd_update_metadata(rd, datebuf); + rd->read_status = 'W'; + rd_close_remdata(&rd); + return(TCL_OK); +} + + + +NAMEVAL_S *sort_key_rules(index) + int index; +{ + static NAMEVAL_S is_rules[] = { + {"Arrival", 0}, + {"Date", 0}, + {"Subject", 0}, + {"Cc", 0}, + {"From", 0}, + {"To", 0}, + {"size", 0}, + {"OrderedSubj", 0}, + {"tHread", 0}, + {"Arrival/Reverse", 0}, + {"Date/Reverse", 0}, + {"Subject/Reverse", 0}, + {"Cc/Reverse", 0}, + {"From/Reverse", 0}, + {"To/Reverse", 0}, + {"size/Reverse", 0}, + {"tHread/Reverse", 0}, + {"OrderedSubj/Reverse", 0} + }; + + return((index >= 0 && index < (sizeof(is_rules)/sizeof(is_rules[0]))) + ? &is_rules[index] : NULL); +} + +NAMEVAL_S *wp_indexheight_rules(index) + int index; +{ + static NAMEVAL_S is_rules[] = { + {"normal font", "24", 0}, + {"smallest font", "20", 0}, + {"small font", "22", 0}, + {"large font", "28", 0}, + {"largest font", "30", 0} + }; + + return((index >= 0 && index < (sizeof(is_rules)/sizeof(is_rules[0]))) + ? &is_rules[index] : NULL); +} + + +/* + * PEDebugCmd - turn on/off and set various debugging options + */ +int +PEDebugCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *s; + + if(!--objc){ /* only one arg? */ + Tcl_WrongNumArgs(interp, 1, objv, "?args?"); + } + else if((s = Tcl_GetStringFromObj(objv[1], NULL)) != NULL){ + if(!strucmp(s, "level")){ + if(objc == 2){ + int level; + + if(Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) + return(TCL_ERROR); + + if(level > 0){ + if(level > 10) + level = 10; + + debug = level; + dprint((1, "Debug level %d", level)); + } + else{ + dprint((1, "PEDebug ending")); + debug = 0; + } + } + + Tcl_SetResult(interp, int2string(debug), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strucmp(s, "write")){ + if(objc == 2 && (s = Tcl_GetStringFromObj(objv[2], NULL))){ + /* + * script debugging has a high priority since + * statements can be added/removed on the fly + * AND are NOT present by default + */ + dprint((SYSDBG_INFO, "SCRIPT: %s", s)); + } + + return(TCL_OK); + } + else if(!strucmp(s, "imap")){ + int level; + + if(Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) + return(TCL_ERROR); + + if(level == 0){ + if(ps_global){ + ps_global->debug_imap = 0; + if(ps_global->mail_stream) + mail_nodebug(ps_global->mail_stream); + } + } + else if(level > 0 && level < 5){ + if(ps_global){ + ps_global->debug_imap = level; + if(ps_global->mail_stream) + mail_debug(ps_global->mail_stream); + } + } + + return(TCL_OK); + } + else + Tcl_SetResult(interp, "Unknown PEDebug request", TCL_STATIC); + } + + return(TCL_ERROR); +} + + +/* + * PESessionCmd - Export TCL Session-wide command set + */ +int +PESessionCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *op, *err = "Unknown PESession option"; + char *pe_user, *pe_host; + int pe_alt, l; + + dprint((2, "PESessionCmd")); + + if((op = Tcl_GetStringFromObj(objv[1], NULL)) != NULL){ + if(!strcmp(op, "open")){ + char *s, *pinerc, *pineconf = NULL; + + /* + * CMD: open user remote-pinerc local-default-config + * + * Initiate a session + * + * Returns: error string on error, nothing otherwise + */ + + if(objc < 4 || objc > 5){ + Tcl_WrongNumArgs(interp, 1, objv, "user password pinerc"); + return(TCL_ERROR); + } + + if(!(s = Tcl_GetStringFromObj(objv[2], &l))){ + Tcl_SetResult(interp, "Unknown User", TCL_STATIC); + return(TCL_ERROR); + } + else{ + int rv; + + pe_user = cpystr(s); + +#if defined(HAVE_SETENV) + rv = setenv("WPUSER", pe_user, 1); +#elif defined(HAVE_PUTENV) + { + static char putenvbuf[PUTENV_MAX]; + + if(l + 8 < PUTENV_MAX){ + if(putenvbuf[0]) /* only called once, but you never know */ + snprintf(putenvbuf + 7, PUTENV_MAX - 7, "%s", pe_user); + else + snprintf(putenvbuf, PUTENV_MAX, "WPUSER=%s", pe_user); + + rv = putenv(putenvbuf); + } + else + rv = 1; + } +#endif + + if(rv){ + fs_give((void **) &pe_user); + Tcl_SetResult(interp, (errno == ENOMEM) + ? "Insufficient Environment Space" + : "Cannot set WPUSER in environment", TCL_STATIC); + return(TCL_ERROR); + } + } + + if((pinerc = Tcl_GetStringFromObj(objv[3], NULL)) != NULL){ + NETMBX mb; + + if(mail_valid_net_parse(pinerc, &mb)){ + pe_host = cpystr(mb.host); + pe_alt = (mb.sslflag || mb.tlsflag); + } + else { + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Non-Remote Config: %s", pinerc); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + } + else { + Tcl_SetResult(interp, "Unknown config location", TCL_STATIC); + return(TCL_ERROR); + } + + if(objc == 5 && !(pineconf = Tcl_GetStringFromObj(objv[4], NULL))){ + Tcl_SetResult(interp, "Can't determine global config", TCL_STATIC); + return(TCL_ERROR); + } + + dprint((SYSDBG_INFO, "session (%s) %s - %s", + pe_user, pinerc, pineconf ? pineconf : "<none>")); + + /* credential cache MUST already be seeded */ + + /* destroy old user context */ + if(ps_global){ + /* destroy open stream */ + peDestroyStream(ps_global); + + /* destroy old user context */ + peDestroyUserContext(&ps_global); + } + + /* Establish a user context */ + if((s = peCreateUserContext(interp, pe_user, pinerc, pineconf)) != NULL){ + Tcl_SetResult(interp, s, TCL_VOLATILE); + return(TCL_ERROR); + } + + fs_give((void **) &pe_user); + fs_give((void **) &pe_host); + + return(TCL_OK); + } + else if(!strcmp(op, "close")){ + if(ps_global){ + /* destroy any open stream */ + peDestroyStream(ps_global); + + /* destroy user context */ + peDestroyUserContext(&ps_global); + } + + Tcl_SetResult(interp, "BYE", TCL_STATIC); + return(TCL_OK); + } + else if(!strcmp(op, "creds")){ + char *folder; + int colid; + + if(objc < 4){ + err = "creds: insufficient args"; + } + else if(Tcl_GetIntFromObj(interp,objv[2],&colid) != TCL_ERROR + && (folder = Tcl_GetStringFromObj(objv[3], NULL))){ + int i; + CONTEXT_S *cp; + + /* + * CMD: creds <collection-index> <folder> [user passwd] + * + * Test for valid credentials to access given folder + * + * Returns: 1 if so, 0 otherwise + */ + + for(i = 0, cp = ps_global ? ps_global->context_list : NULL; + i < 1 || cp != NULL ; + i++, cp = cp->next) + if(i == colid){ + int rv = 0; + char tmp[MAILTMPLEN], *p; + + if(cp){ + if(folder[0] == '\0'){ + if(cp->use & CNTXT_INCMNG) + rv = 1; + else + folder = "fake-fake"; + } + else if((cp->use & CNTXT_INCMNG) + && (p = folder_is_nick(folder, FOLDERS(cp), FN_NONE))) + folder = p; + } + + if(!rv && context_allowed(context_apply(tmp, cp, folder, sizeof(tmp)))){ + NETMBX mb; + + if(mail_valid_net_parse(tmp, &mb)){ + if(objc == 4){ /* check creds */ + if(!*mb.user && (p = alpine_get_user(mb.host, (mb.sslflag || mb.tlsflag)))) + strcpy(mb.user, p); + + if(alpine_have_passwd(mb.user, mb.host, (mb.sslflag || mb.tlsflag))) + rv = 1; + } + else if(objc == 6){ /* set creds */ + char *user, *passwd; + + if((user = Tcl_GetStringFromObj(objv[4], NULL)) + && (passwd = Tcl_GetStringFromObj(objv[5], NULL))){ + if(*mb.user && strcmp(mb.user, user)){ + err = "creds: mismatched user names"; + break; + } + + alpine_set_passwd(user, passwd, mb.host, + mb.sslflag + || mb.tlsflag + || (ps_global ? F_ON(F_PREFER_ALT_AUTH, ps_global) : 0)); + rv = 1; + } + else { + err = "creds: unable to read credentials"; + break; + } + } + else{ + err = "creds: invalid args"; + break; + } + } + } + + (void) Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewIntObj(rv)); + return(TCL_OK); + } + + err = "creds: Unrecognized collection ID"; + } + else + err = "creds: failure to acquire folder and collection ID"; + } + else if(!strcmp(op, "nocred")){ + char *folder; + int colid; + + if(!ps_global){ + err = "No Session active"; + } + else if(objc != 4){ + err = "nocred: wrong number of args"; + } + else if(Tcl_GetIntFromObj(interp,objv[2],&colid) != TCL_ERROR + && (folder = Tcl_GetStringFromObj(objv[3], NULL))){ + int i; + CONTEXT_S *cp; + + /* + * CMD: nocred <collection-index> <folder> + * + * Test for valid credentials to access given folder + * + * Returns: 1 if so, 0 otherwise + */ + + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid){ + int rv = 0; + char tmp[MAILTMPLEN], *p; + + if((cp->use & CNTXT_INCMNG) + && (p = folder_is_nick(folder, FOLDERS(cp), FN_NONE))) + folder = p; + + if(context_allowed(context_apply(tmp, cp, folder, sizeof(tmp)))){ + NETMBX mb; + + if(mail_valid_net_parse(tmp, &mb)){ + if(!*mb.user && (p = alpine_get_user(mb.host, (mb.sslflag || mb.tlsflag)))) + strcpy(mb.user, p); + + alpine_clear_passwd(mb.user, mb.host); + } + } + + (void) Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewIntObj(rv)); + return(TCL_OK); + } + + err = "creds: Unrecognized collection ID"; + } + else + err = "creds: failure to acquire folder and collection ID"; + } + else if(!strcmp(op, "acceptcert")){ + char *certhost; + STRLIST_S **p; + + if((certhost = Tcl_GetStringFromObj(objv[2], NULL))){ + for(p = &peCertHosts; *p; p = &(*p)->next) + ; + + *p = new_strlist(certhost); + } + + err = "PESession: no server name"; + } + else if(!strcmp(op, "random")){ + if(objc != 3){ + err = "PESession: random <length>"; + } else { + char s[1025]; + int l; + + if(Tcl_GetIntFromObj(interp,objv[2],&l) != TCL_ERROR){ + if(l <= 1024){ + Tcl_SetResult(interp, peRandomString(s,l,PRS_MIXED_CASE), TCL_STATIC); + return(TCL_OK); + } + else + err = "PESession: random length too long"; + } + else + err = "PESession: can't get random length"; + } + } + else if(!strcmp(op, "authdriver")){ + if(objc != 4){ + err = "PESession: authdriver {add | remove} drivername"; + } else { + char *cmd, *driver; + + if((cmd = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if((driver = Tcl_GetStringFromObj(objv[3], NULL)) != NULL){ + if(!strcmp(cmd,"enable")){ + err = "PESession: authdriver enable disabled for the nonce"; + } + else if(!strcmp(cmd,"disable")){ + if(mail_parameters(NULL, DISABLE_AUTHENTICATOR, (void *) driver)){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Authentication driver %.30s disabled", driver); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_OK); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "PESession: Can't disable %.30s", driver); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + } + else + err = "PESession: unknown authdriver operation"; + } + else + err = "PESession: Can't read driver name"; + } + else + err = "PESesions: Can't read authdriver operation"; + } + } + else if(!strcmp(op, "abandon")){ + /* + * CMD: abandon [timeout] + * + * Returns: nothing + */ + + if(objc != 3){ + err = "PESession: abandon [timeout]"; + } else { + long t; + + if(Tcl_GetLongFromObj(interp, objv[2], &t) == TCL_OK){ + /* ten second minimum and max of default */ + if(t > 0 && t <= PE_INPUT_TIMEOUT){ + gPEAbandonTimeout = t; + return(TCL_OK); + } + else + err = "unrecognized timeout"; + } + else + err = "Can't read timeout"; + } + } + else if(!strcmp(op, "noexpunge")){ + /* + * CMD: noexpunge <state> + * + * Returns: nothing + */ + + if(objc != 3){ + err = "PESession: noexpunge <state>"; + } else { + int onoff; + + if(Tcl_GetIntFromObj(interp, objv[2], &onoff) == TCL_OK){ + if(onoff == 0 || onoff == 1){ + ps_global->noexpunge_on_close = onoff; + return(TCL_OK); + } + + err = "unrecognized on/off state"; + } + else + err = "Can't read on/off state"; + } + } + else if(!strcmp(op, "setpassphrase")){ +#ifdef SMIME + char *passphrase; + + if(objc != 3){ + err = "PESession: setpassphrase <state>"; + } + else if((passphrase = Tcl_GetStringFromObj(objv[2], NULL))){ + if(ps_global && ps_global->smime){ + strncpy((char *) ps_global->smime->passphrase, passphrase, + sizeof(ps_global->smime->passphrase)); + ps_global->smime->passphrase[sizeof(ps_global->smime->passphrase)-1] = '\0'; + ps_global->smime->entered_passphrase = 1; + ps_global->smime->need_passphrase = 0; + peED.uid = 0; + return(TCL_OK); + } + } +#else + err = "S/MIME not configured for this server"; +#endif /* SMIME */ + } + else if(!strcmp(op, "expungecheck")) { + /* + * Return open folders and how many deleted messages they have + * + * return looks something like a list of these: + * {folder-name number-deleted isinbox isincoming} + */ + char *type; + long delete_count; + Tcl_Obj *resObj; + + if(objc != 3){ + err = "PESession: expungecheck <type>"; + } + else { + type = Tcl_GetStringFromObj(objv[2], NULL); + if(type && (strcmp(type, "current") == 0 || strcmp(type, "quit") == 0)){ + + if(ps_global->mail_stream != sp_inbox_stream() + || strcmp(type, "current") == 0){ + delete_count = count_flagged(ps_global->mail_stream, F_DEL); + resObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(pretty_fn(ps_global->cur_folder), -1)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewIntObj(delete_count)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewIntObj((ps_global->mail_stream + == sp_inbox_stream()) + ? 1 : 0)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewIntObj((ps_global->context_current->use & CNTXT_INCMNG) + ? 1 : 0)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + resObj); + } + if(strcmp(type, "quit") == 0){ + delete_count = count_flagged(sp_inbox_stream(), F_DEL); + resObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj("INBOX", -1)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewIntObj(delete_count)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewIntObj(1)); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewIntObj(1)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), resObj); + } + return(TCL_OK); + } + else + err = "PESession: expungecheck unknown type"; + } + } + else if(!strcmp(op, "mailcheck")) { + /* + * CMD: mailcheck + * + * ARGS: reload -- "1" if we're reloading + * (vs. just checking newmail as a side effect + * of building a new page) + * + * Return list of folders with new or expunged messages + * + * return looks something like a list of these: + * {new-count newest-uid announcement-msg} + */ + int reload, force = UFU_NONE, rv; + time_t now = time(0); + + if(objc <= 3){ + if(objc < 3 || Tcl_GetIntFromObj(interp, objv[2], &reload) == TCL_ERROR) + reload = 0; + + /* minimum 10 second between IMAP pings */ + if(!time_of_last_input() || now - time_of_last_input() > 10){ + force = UFU_FORCE; + if(!reload) + peMarkInputTime(); + } + + peED.interp = interp; + + /* check for new mail */ + new_mail(force, reload ? GoodTime : VeryBadTime, NM_STATUS_MSG); + + if(!reload){ /* announced */ + zero_new_mail_count(); + } + + return(TCL_OK); + } + else + err = "PESession: mailcheck <reload>"; + } + } + + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + + +/* + * PEFolderChange - create context's directory chain + * corresponding to list of given obj's + * + * NOTE: caller should call reset_context_folders(cp) to + * clean up data structures this creates before returning + */ +int +PEFolderChange(Tcl_Interp *interp, CONTEXT_S *cp, int objc, Tcl_Obj *CONST objv[]) +{ + int i; + FDIR_S *fp; + char *folder; + + for(i = 0; i < objc; i++) { + folder = Tcl_GetStringFromObj(objv[i], NULL); + if(!folder) { + Tcl_SetResult(interp, "PEFolderChange: Can't read folder", TCL_VOLATILE); + reset_context_folders(cp); + return(TCL_ERROR); + } + + fp = next_folder_dir(cp, folder, 0, NULL); /* BUG: mail_stream? */ + fp->desc = folder_lister_desc(cp, fp); + fp->delim = cp->dir->delim; + fp->prev = cp->dir; + fp->status |= CNTXT_SUBDIR; + cp->dir = fp; + } + + return(TCL_OK); +} + +/* + * PEMakeFolderString: + */ +int +PEMakeFolderString(Tcl_Interp *interp, CONTEXT_S *cp, int objc, Tcl_Obj *CONST objv[], char **ppath) +{ + int i; + unsigned long size,len; + char *portion,*path; + + size = 0; + for(i = 0; i < objc; i++) { + portion = Tcl_GetStringFromObj(objv[i], NULL); + if(!portion) { + Tcl_SetResult(interp, "PEMakeFolderString: Can't read folder", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(i) size++; + size += strlen(portion); + } + + path = (char*) fs_get(size + 1); + size = 0; + for(i = 0; i < objc; i++) { + portion = Tcl_GetStringFromObj(objv[i], NULL); + len = strlen(portion); + if(i) path[size++] = cp->dir->delim; + memcpy(path + size, portion, len); + size += len; + } + path[size] = '\0'; + if(ppath) *ppath = path; else fs_give((void**) &path); + return(TCL_OK); +} + + +/* + * PEFolderCmd - export various bits of folder information + */ +int +PEFolderCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *op, errbuf[256], *err = "Unknown PEFolder request"; + + dprint((2, "PEFolderCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + } + else if((op = Tcl_GetStringFromObj(objv[1], NULL)) != NULL){ + if(ps_global){ + if(objc == 2){ + if(!strcmp(op, "current")){ + CONTEXT_S *cp; + int i; + + /* + * CMD: current + * + * Returns: string representing the name of the + * current mailbox + */ + + for(i = 0, cp = ps_global->context_list; cp && cp != ps_global->context_current; i++, cp = cp->next) + ; + + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewIntObj(cp ? i : 0)) == TCL_OK + && Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(ps_global->cur_folder,-1)) == TCL_OK) + return(TCL_OK); + + return(TCL_ERROR); + } + else if(!strcmp(op, "collections")){ + CONTEXT_S *cp; + int i; + + /* + * CMD: collections + * + * Returns: List of currently configured collections + */ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next){ + Tcl_Obj *objv[3]; + + objv[0] = Tcl_NewIntObj(i); + objv[1] = Tcl_NewStringObj(cp->nickname ? cp->nickname : "", -1); + objv[2] = Tcl_NewStringObj(cp->label ? cp->label : "", -1); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(3, objv)); + } + + return(TCL_OK); + } + else if(!strcmp(op, "defaultcollection")){ + int i; + CONTEXT_S *cp; + + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(cp->use & CNTXT_SAVEDFLT){ + Tcl_SetResult(interp, int2string(i), TCL_STATIC); + return(TCL_OK); + } + + err = "PEFolder: isincoming: Invalid collection ID"; + } + else if(!strcmp(op, "clextended")){ + CONTEXT_S *cp; + int i; + char tpath[MAILTMPLEN], *p; + + /* + * CMD: clextended + * + * Returns: Extended list of current collections + * + * Format: + * 0) Collection Number + * 1) Nickname + * 2) Label + * 3) Basically this is a flag to say if we can edit + * 4) Server + * 5) Path + * 6) View + */ + /* + * had to get rid of this cause the args are changed + * + * if(strcmp("extended", + * Tcl_GetStringFromObj(objv[2], NULL))){ + * Tcl_SetResult(interp, "invalid argument", TCL_VOLATILE); + * return(TCL_ERROR); + * } + */ + for(i = 0, cp = ps_global->context_list; cp ; + i++, cp = cp->next){ + Tcl_Obj *objv[7]; + + objv[0] = Tcl_NewIntObj(i); + objv[1] = Tcl_NewStringObj(cp->nickname ? + cp->nickname : "", -1); + objv[2] = Tcl_NewStringObj(cp->label ? + cp->label : "", -1); + objv[3] = Tcl_NewIntObj(cp->var.v ? 1 : 0); + objv[4] = Tcl_NewStringObj(cp->server ? + cp->server : "", -1); + tpath[0] = '\0'; + if(cp->context){ + strncpy(tpath, (cp->context[0] == '{' + && (p = strchr(cp->context, '}'))) + ? ++p + : cp->context, sizeof(tpath)); + tpath[sizeof(tpath)-1] = '\0'; + if((p = strstr(tpath, "%s")) != NULL) + *p = '\0'; + } + objv[5] = Tcl_NewStringObj(tpath, -1); + objv[6] = Tcl_NewStringObj(cp->dir && + cp->dir->view.user ? + cp->dir->view.user : + "", -1); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewListObj(7, objv)); + } + + return(TCL_OK); + } + } + else if(objc == 3 && !strcmp(op, "delimiter")){ + int colid, i; + char delim[2] = {'\0', '\0'}; + CONTEXT_S *cp; + + if(Tcl_GetIntFromObj(interp,objv[2],&colid) != TCL_ERROR){ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid){ + if(cp->dir && cp->dir->delim) + delim[0] = cp->dir->delim; + + break; + } + + Tcl_SetResult(interp, delim[0] ? delim : "/", TCL_VOLATILE); + return(TCL_OK); + } + else + err = "PEFolder: delimiter: Can't read collection ID"; + } + else if(objc == 3 && !strcmp(op, "isincoming")){ + int colid, i; + CONTEXT_S *cp; + + if(Tcl_GetIntFromObj(interp,objv[2],&colid) != TCL_ERROR){ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid){ + Tcl_SetResult(interp, int2string(((cp->use & CNTXT_INCMNG) != 0)), TCL_STATIC); + return(TCL_OK); + } + + err = "PEFolder: isincoming: Invalid collection ID"; + } + else + err = "PEFolder: isincoming: Can't read collection ID"; + } + else if(objc == 4 && !strcmp(op, "unread")){ + char *folder, tmp[MAILTMPLEN]; + MAILSTREAM *mstream; + CONTEXT_S *cp; + long colid, i, count = 0, flags = (F_UNSEEN | F_UNDEL); + int our_stream = 0; + /* + * CMD: unread + * + * Returns: number of unread messages in given + * folder + */ + if(Tcl_GetLongFromObj(interp,objv[2],&colid) != TCL_ERROR){ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid) + break; + + if(cp){ + if((folder = Tcl_GetStringFromObj(objv[3], NULL)) != NULL){ + /* short circuit INBOX */ + if(colid == 0 && !strucmp(folder, "inbox")){ + count = count_flagged(sp_inbox_stream(), flags); + } + else{ + /* + * BUG: some sort of caching to prevent open() fore each call? + * does stream cache offset this? + */ + if(!(context_allowed(context_apply(tmp, cp, folder, sizeof(tmp))) + && (mstream = same_stream_and_mailbox(tmp, ps_global->mail_stream)))){ + long retflags = 0; + + ps_global->noshow_error = 1; + our_stream = 1; + mstream = context_open(cp, NULL, folder, + SP_USEPOOL | SP_TEMPUSE| OP_READONLY | OP_SHORTCACHE, + &retflags); + ps_global->noshow_error = 0; + } + + count = count_flagged(mstream, flags); + + if(our_stream) + pine_mail_close(mstream); + } + + Tcl_SetResult(interp, long2string(count), TCL_VOLATILE); + return(TCL_OK); + } + } + else + err = "PEFolder: unread: Invalid collection ID"; + } + else + err = "PEFolder: unread: Can't read collection ID"; + } + else if(objc == 5 && !strcmp(op, "empty")){ + /* + * CMD: empty + * + * Returns: number of expunge messages + * + * Arguments: <colnum> <folder> <what> + * where <what> is either <uid>, 'selected', or 'all' + */ + CONTEXT_S *cp; + MAILSTREAM *stream = NULL; + MESSAGECACHE *mc; + MSGNO_S *msgmap; + int colid, i, our_stream = 0; + long uid, raw, count = 0L; + char *errstr = NULL, *what, *folder, *p, tmp[MAILTMPLEN]; + + if(Tcl_GetIntFromObj(interp,objv[2],&colid) != TCL_ERROR){ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid) break; + } + + if(cp){ + if((folder = Tcl_GetStringFromObj(objv[3], NULL)) != NULL){ + if((what = Tcl_GetStringFromObj(objv[4], NULL)) != NULL){ + /* need to open? */ + if(!((context_allowed(context_apply(tmp, cp, folder, sizeof(tmp))) + && (stream = same_stream_and_mailbox(tmp, ps_global->mail_stream))) + || (stream = same_stream_and_mailbox(tmp, sp_inbox_stream())))){ + long retflags = 0; + + our_stream = 1; + stream = context_open(cp, NULL, folder, SP_USEPOOL | SP_TEMPUSE | OP_SHORTCACHE, &retflags); + } + + if(stream){ + msgmap = sp_msgmap(stream); + + if(!strucmp(what, "all")){ + if(mn_get_total(msgmap)){ + agg_select_all(stream, msgmap, NULL, 1); + errstr = peApplyFlag(stream, msgmap, 'd', 0, &count); + if(!errstr) + (void) cmd_expunge_work(stream, msgmap); + } + } + else{ + /* little complicated since we don't display deleted state and + * don't want to expunge what's not intended. + * remember what's deleted and restore state on the ones left + * when we're done. shouldn't happen much. + * NOTE: "uid" is NOT a UID in this loop + */ + for(uid = 1L; uid <= mn_get_total(msgmap); uid++){ + raw = mn_m2raw(msgmap, uid); + if(!get_lflag(stream, msgmap, uid, MN_EXLD) + && (mc = mail_elt(stream, raw)) != NULL + && mc->deleted){ + set_lflag(stream, msgmap, uid, MN_STMP, 1); + mail_flag(stream, long2string(raw), "\\DELETED", 0L); + } + else + set_lflag(stream, msgmap, uid, MN_STMP, 0); + } + + if(!strucmp(what,"selected")){ + if(any_lflagged(msgmap, MN_SLCT)){ + if(!(errstr = peApplyFlag(stream, msgmap, 'd', 0, &count))) + (void) cmd_expunge_work(stream, msgmap); + } + else + count = 0L; + } + else{ + uid = 0; + for(p = what; *p; p++) + if(isdigit((unsigned char) *p)){ + uid = (uid * 10) + (*p - '0'); + } + else{ + errstr = "Invalid uid value"; + break; + } + + if(!errstr && uid){ + /* uid is a UID here */ + mail_flag(stream, long2string(uid), "\\DELETED", ST_SET | ST_UID); + (void) cmd_expunge_work(stream, msgmap); + count = 1L; + } + } + + /* restore deleted on what didn't get expunged */ + for(uid = 1L; uid <= mn_get_total(msgmap); uid++){ + raw = mn_m2raw(msgmap, uid); + if(get_lflag(stream, msgmap, uid, MN_STMP)){ + set_lflag(stream, msgmap, uid, MN_STMP, 0); + mail_flag(stream, long2string(raw), "\\DELETED", ST_SET); + } + } + } + + if(our_stream) + pine_mail_close(stream); + } + else + errstr = "no stream"; + } + else + errstr = "Cannot get which "; + } + else + errstr = "Cannot get folder"; + } + else + errstr = "Invalid collection"; + + if(errstr){ + Tcl_SetResult(interp, errstr, TCL_VOLATILE); + return(TCL_ERROR); + } + + Tcl_SetResult(interp, long2string(count), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "export")){ + /* + * CMD: export + * + * Returns: success or failure after writing given + * folder to given local file. + * + * Format: + * 0) Collection Number + * 1) Folder + * 2) Destination file + */ + if(objc == 5){ + CONTEXT_S *cp; + MAILSTREAM *src; + APPEND_PKG pkg; + STRING msg; + long colid, i; + char *folder, *dfile, seq[64], tmp[MAILTMPLEN]; + int our_stream = 0; + + if(Tcl_GetLongFromObj(interp,objv[2],&colid) != TCL_ERROR){ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid) + break; + + if(cp){ + if((folder = Tcl_GetStringFromObj(objv[3], NULL)) != NULL){ + if((dfile = Tcl_GetStringFromObj(objv[4], NULL)) != NULL){ + if(mail_parameters(NULL, ENABLE_DRIVER, "unix")){ + + snprintf(tmp, sizeof(tmp), "#driver.unix/%s", dfile); + + if(pine_mail_create(NULL, tmp)){ + + err = NULL; /* reset error condition */ + + /* + * if not current folder, open a stream, setup the + * stuff to write the raw header/text by hand + * with berkeley delimiters since we don't want + * a local mailbox driver lunk in. + * + * comments: + * - BUG: what about logins? + * + */ + if(!(context_allowed(context_apply(tmp, cp, folder, sizeof(tmp))) + && (src = same_stream_and_mailbox(tmp, ps_global->mail_stream)))){ + long retflags = 0; + + our_stream = 1; + src = context_open(cp, NULL, folder, + SP_USEPOOL | SP_TEMPUSE | OP_READONLY | OP_SHORTCACHE, + &retflags); + } + + if(src && src->nmsgs){ + /* Go to work...*/ + pkg.stream = src; + pkg.msgno = 0; + pkg.msgmax = src->nmsgs; + pkg.flags = pkg.date = NIL; + pkg.message = &msg; + + snprintf (seq,sizeof(seq),"1:%lu",src->nmsgs); + mail_fetchfast (src, seq); + + ps_global->noshow_error = 1; + if(!mail_append_multiple (NULL, dfile, + peAppendMsg, (void *) &pkg)){ + snprintf(err = errbuf, sizeof(errbuf), "PEFolder: export: %.200s", + ps_global->c_client_error); + } + + ps_global->noshow_error = 0; + + if(our_stream) + pine_mail_close(src); + } + else + err = "PEFolder: export: can't open mail folder"; + + if(!err) + return(TCL_OK); + } + else + err = "PEFolder: export: can't create destination"; + + if(!mail_parameters(NULL, DISABLE_DRIVER, "unix")) + err = "PEFolder: export: can't disable driver"; + } + else + err = "PEFolder: export: can't enable driver"; + } + else + err = "PEFolder: export: can't read file name"; + } + else + err = "PEFolder: export: can't read folder name"; + } + else + err = "PEFolder: export: Invalid collection ID"; + } + else + err = "PEFolder:export: Can't read collection ID"; + } + else + err = "PEFolder: export <colid> <folder> <file>"; + } + else if(!strcmp(op, "import")){ + /* + * CMD: import + * + * Returns: success or failure after writing given + * folder to given local file. + * + * Format: + * 0) source file + * 1) destination collection number + * 2) destination folder + */ + if(objc == 5){ + CONTEXT_S *cp; + MAILSTREAM *src, *dst; + APPEND_PKG pkg; + STRING msg; + long colid, i; + char *folder, *sfile, seq[64]; + + /* get source file with a little sanity check */ + if((sfile = Tcl_GetStringFromObj(objv[2], NULL)) + && *sfile == '/' && !strstr(sfile, "..")){ + if(mail_parameters(NULL, ENABLE_DRIVER, "unix")){ + + ps_global->noshow_error = 1; /* don't queue error msg */ + err = NULL; /* reset error condition */ + + /* make sure sfile contains valid mail */ + if((src = mail_open(NULL, sfile, 0L)) != NULL){ + + if(Tcl_GetLongFromObj(interp,objv[3],&colid) != TCL_ERROR){ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid) + break; + + if(cp){ + if((folder = Tcl_GetStringFromObj(objv[4], NULL)) != NULL){ + long retflags = 0; + + if(context_create(cp, NULL, folder) + && (dst = context_open(cp, NULL, folder, SP_USEPOOL | SP_TEMPUSE, &retflags))){ + + if(src->nmsgs){ + /* Go to work...*/ + pkg.stream = src; + pkg.msgno = 0; + pkg.msgmax = src->nmsgs; + pkg.flags = pkg.date = NIL; + pkg.message = &msg; + + snprintf (seq,sizeof(seq),"1:%lu",src->nmsgs); + mail_fetchfast (src, seq); + + if(!context_append_multiple(cp, dst, folder, + peAppendMsg, (void *) &pkg, + ps_global->mail_stream)){ + snprintf(err = errbuf, sizeof(errbuf), "PEFolder: import: %.200s", + ps_global->c_client_error); + } + + } + + pine_mail_close(dst); + } + else + snprintf(err = errbuf, sizeof(errbuf), "PEFolder: import: %.200s", + ps_global->c_client_error); + } + else + err = "PEFolder: import: can't read folder name"; + } + else + err = "PEFolder:import: invalid collection id"; + } + else + err = "PEFolder: import: can't read collection id"; + + mail_close(src); + + } + else + snprintf(err = errbuf, sizeof(errbuf), "PEFolder: import: %.200s", + ps_global->c_client_error); + + ps_global->noshow_error = 0; + + if(!mail_parameters(NULL, DISABLE_DRIVER, "unix") && !err) + err = "PEFolder: import: can't disable driver"; + + if(!err) + return(TCL_OK); + } + else + err = "PEFolder: import: can't enable driver"; + } + else + err = "PEFolder: import: can't read file name"; + } + else + err = "PEFolder: import <file> <colid> <folder>"; + } + else { + int i, colid; + char *aes, *colstr; + CONTEXT_S *cp; + + /* + * 3 or more arguments, 3rd is the collection ID, rest + * are a folder name + */ + + if(Tcl_GetIntFromObj(interp,objv[2],&colid) != TCL_ERROR){ + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid) break; + } + else if((colstr = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(!strcmp("default", colstr)) + cp = default_save_context(ps_global->context_list); + else + cp = NULL; + } + else + cp = NULL; + + if(cp){ + if(!strcmp(op, "list")){ + int i, fcount, bflags = BFL_NONE; + + if(PEFolderChange(interp, cp, objc - 3, objv + 3) == TCL_ERROR) + return TCL_ERROR; + + if(cp->use & CNTXT_NEWS) + bflags |= BFL_LSUB; + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + + pePrepareForAuthException(); + + build_folder_list(NULL, cp, "*", NULL, bflags); + + if((aes = peAuthException()) != NULL){ + Tcl_SetResult(interp, aes, TCL_VOLATILE); + reset_context_folders(cp); + return(TCL_ERROR); + } + + if((fcount = folder_total(FOLDERS(cp))) != 0){ + for(i = 0; i < fcount; i++){ + char type[3], *p; + FOLDER_S *f = folder_entry(i, FOLDERS(cp)); + + p = type; + if(f->isdir){ + *p++ = 'D'; + + if(f->hasnochildren && !f->haschildren) + *p++ = 'E'; + } + + if(f->isfolder + || f->nickname + || (cp->use & CNTXT_INCMNG)) + *p++ = 'F'; + + *p = '\0'; + + peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", type, + f->nickname ? f->nickname : f->name); + } + } + + reset_context_folders(cp); + return(TCL_OK); + } + else if(!strucmp(op, "exists")){ + char *folder, *errstr = NULL; + int rv; + + if(objc < 4) { + Tcl_SetResult(interp, "PEFolder exists: No folder specified", TCL_VOLATILE); + return(TCL_ERROR); + } + folder = Tcl_GetStringFromObj(objv[objc - 1], NULL); + if(!folder) { + Tcl_SetResult(interp, "PEFolder exists: Can't read folder", TCL_VOLATILE); + return(TCL_ERROR); + } + + if(PEFolderChange(interp, cp, objc - 4, objv + 3) == TCL_ERROR) + return TCL_ERROR; + + ps_global->c_client_error[0] = '\0'; + pePrepareForAuthException(); + + rv = folder_name_exists(cp, folder, NULL); + + if(rv & FEX_ERROR){ + if((errstr = peAuthException()) == NULL){ + if(ps_global->c_client_error[0]) + errstr = ps_global->c_client_error; + else + errstr = "Indeterminate Error"; + } + } + + Tcl_SetResult(interp, errstr ? errstr : int2string((int)(rv & FEX_ISFILE)), TCL_VOLATILE); + return(errstr ? TCL_ERROR : TCL_OK); + } + else if(!strucmp(op, "fullname")){ + char *folder, *fullname; + + if(objc < 4) { + Tcl_SetResult(interp, "PEFolder fullname: No folder specified", TCL_VOLATILE); + return(TCL_ERROR); + } + folder = Tcl_GetStringFromObj(objv[objc - 1], NULL); + if(!folder) { + Tcl_SetResult(interp, "PEFolder fullname: Can't read folder", TCL_VOLATILE); + return(TCL_ERROR); + } + + if(PEFolderChange(interp, cp, objc - 4, objv + 3) == TCL_ERROR) + return TCL_ERROR; + +#if 0 + Tcl_Obj *obj = Tcl_NewStringObj((fullname = folder_is_nick(folder, FOLDERS(cp))) + ? fullname : folder, -1); + (void) Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + obj); +#else + Tcl_SetResult(interp, + (fullname = folder_is_nick(folder, FOLDERS(cp), FN_NONE)) ? fullname : folder, + TCL_VOLATILE); +#endif + + return(TCL_OK); + } + else if(!strucmp(op, "create")){ + char *aes, *folder; + + folder = Tcl_GetStringFromObj(objv[objc - 1], NULL); + if(!folder) { + Tcl_SetResult(interp, "PEFolder create: Can't read folder", TCL_VOLATILE); + return(TCL_ERROR); + } + + if(PEFolderChange(interp, cp, objc - 4, objv + 3) == TCL_ERROR) + return TCL_ERROR; + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + pePrepareForAuthException(); + + if(!context_create(cp, NULL, folder)){ + if((aes = peAuthException()) != NULL){ + Tcl_SetResult(interp, aes, TCL_VOLATILE); + } + else{ + Tcl_SetResult(interp, + (ps_global->last_error[0]) + ? ps_global->last_error + : (ps_global->c_client_error[0]) + ? ps_global->c_client_error + : "Unable to create folder", + TCL_VOLATILE); + } + + reset_context_folders(cp); + return(TCL_ERROR); + } + + Tcl_SetResult(interp, "OK", TCL_STATIC); + reset_context_folders(cp); + return(TCL_OK); + } + else if(!strucmp(op, "delete")){ + int fi, readonly, close_opened = 0; + char *folder, *fnamep, *target = NULL, *aes; + MAILSTREAM *del_stream = NULL, *strm = NULL; + EditWhich ew; + PINERC_S *prc = NULL; + FOLDER_S *fp; + + folder = Tcl_GetStringFromObj(objv[objc - 1], NULL); + if(!folder) { + Tcl_SetResult(interp, "PEFolder delete: Can't read folder", TCL_VOLATILE); + return(TCL_ERROR); + } + + if(PEFolderChange(interp, cp, objc - 4, objv + 3) == TCL_ERROR) + return TCL_ERROR; + + /* so we can check for folder's various properties */ + build_folder_list(NULL, cp, folder, NULL, BFL_NONE); + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + + pePrepareForAuthException(); + + /* close open folder, then delete */ + + if((fi = folder_index(folder, cp, FI_FOLDER)) < 0 + || (fp = folder_entry(fi, FOLDERS(cp))) == NULL){ + Tcl_SetResult(interp, "Cannot find folder to delete", TCL_STATIC); + reset_context_folders(cp); + return(TCL_ERROR); + } + + if(!((cp->use & CNTXT_INCMNG) && fp->name + && check_for_move_mbox(fp->name, NULL, 0, &target))){ + target = NULL; + } + + dprint((4, "=== delete_folder(%s) ===\n", folder ? folder : "?")); + + ew = config_containing_inc_fldr(fp); + if(ps_global->restricted) + readonly = 1; + else{ + switch(ew){ + case Main: + prc = ps_global->prc; + break; + case Post: + prc = ps_global->post_prc; + break; + case None: + break; + } + + readonly = prc ? prc->readonly : 1; + } + + if(prc && prc->quit_to_edit && (cp->use & CNTXT_INCMNG)){ + Tcl_SetResult(interp, "Must Exit Alpine to Change Configuration", TCL_STATIC); + reset_context_folders(cp); + return(TCL_ERROR); + } + + if(cp == ps_global->context_list + && !(cp->dir && cp->dir->ref) + && strucmp(folder, ps_global->inbox_name) == 0){ + Tcl_SetResult(interp, "Cannot delete special folder", TCL_STATIC); + reset_context_folders(cp); + return(TCL_ERROR); + } + else if(readonly && (cp->use & CNTXT_INCMNG)){ + Tcl_SetResult(interp, "Folder not in editable config file", TCL_STATIC); + reset_context_folders(cp); + return(TCL_ERROR); + } + else if((fp->name + && (strm=context_already_open_stream(cp,fp->name,AOS_NONE))) + || + (target + && (strm=context_already_open_stream(NULL,target,AOS_NONE)))){ + if(strm == ps_global->mail_stream) + close_opened++; + } + else if(fp->isdir || fp->isdual){ /* NO DELETE if directory isn't EMPTY */ + FDIR_S *fdirp = next_folder_dir(cp,folder,TRUE,NULL); + int ret; + + if(fp->haschildren) + ret = 1; + else if(fp->hasnochildren) + ret = 0; + else{ + ret = folder_total(fdirp->folders) > 0; + free_fdir(&fdirp, 1); + } + + if(ret){ + Tcl_SetResult(interp, "Cannot delete non-empty directory", TCL_STATIC); + reset_context_folders(cp); + return(TCL_ERROR); + } + + /* + * Folder by the same name exist, so delete both... + if(fp->isdual){ + Tcl_SetResult(interp, "Cannot delete: folder is also a directory", TCL_STATIC); + reset_context_folders(cp); + return(TCL_ERROR); + } + */ + } + + if(cp->use & CNTXT_INCMNG){ + Tcl_SetResult(interp, "Cannot delete incoming folder", TCL_STATIC); + reset_context_folders(cp); + return(TCL_ERROR); + } + + dprint((2,"deleting \"%s\" (%s) in context \"%s\"\n", + fp->name ? fp->name : "?", + fp->nickname ? fp->nickname : "", + cp->context ? cp->context : "?")); + if(strm){ + /* + * Close it, NULL the pointer, and let do_broach_folder fixup + * the rest... + */ + pine_mail_actually_close(strm); + if(close_opened){ + do_broach_folder(ps_global->inbox_name, + ps_global->context_list, + NULL, DB_INBOXWOCNTXT); + } + } + + /* + * Use fp->name since "folder" may be a nickname... + */ + if(ps_global->mail_stream + && context_same_stream(cp, fp->name, ps_global->mail_stream)) + del_stream = ps_global->mail_stream; + + fnamep = fp->name; + + if(!context_delete(cp, del_stream, fnamep)){ + if((aes = peAuthException()) != NULL){ + Tcl_SetResult(interp, aes, TCL_VOLATILE); + } + else{ + Tcl_SetResult(interp, + (ps_global->last_error[0]) + ? ps_global->last_error + : (ps_global->c_client_error[0]) + ? ps_global->c_client_error + : "Unable to delete folder", + TCL_VOLATILE); + } + + reset_context_folders(cp); + return(TCL_ERROR); + } + + + Tcl_SetResult(interp, "OK", TCL_STATIC); + reset_context_folders(cp); + return(TCL_OK); + } + /* + * must be at least 5 arguments for the next set of commands + */ + else if(objc < 5) { + Tcl_SetResult(interp, "PEFolder: not enough arguments", TCL_VOLATILE); + return(TCL_ERROR); + } + else if(!strucmp(op, "rename")){ + char *folder,*newfolder, *aes; + + folder = Tcl_GetStringFromObj(objv[objc - 2], NULL); + if(!folder) { + Tcl_SetResult(interp, "PEFolder rename: Can't read folder", TCL_VOLATILE); + return(TCL_ERROR); + } + + newfolder = Tcl_GetStringFromObj(objv[objc - 1], NULL); + if(!newfolder) { + Tcl_SetResult(interp, "PEFolder rename: Can't read folder", TCL_VOLATILE); + return(TCL_ERROR); + } + + if(PEFolderChange(interp, cp, objc - 5, objv + 3) == TCL_ERROR) + return TCL_ERROR; + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + pePrepareForAuthException(); + + if(!context_rename(cp, NULL, folder, newfolder)){ + if((aes = peAuthException()) != NULL){ + Tcl_SetResult(interp, aes, TCL_VOLATILE); + } + else{ + Tcl_SetResult(interp, + (ps_global->last_error[0]) + ? ps_global->last_error + : (ps_global->c_client_error[0]) + ? ps_global->c_client_error + : "Unable to rename folder", + TCL_VOLATILE); + } + reset_context_folders(cp); + return(TCL_ERROR); + } + Tcl_SetResult(interp, "OK", TCL_STATIC); + reset_context_folders(cp); + return(TCL_OK); + } + } + else + err = "PEFolder: Unrecognized collection ID"; + } + } + else + err = "No User Context Established"; + } + + Tcl_SetResult(interp, err, TCL_VOLATILE); + return(TCL_ERROR); +} + + +/* + * PEMailboxCmd - export various bits of mailbox information + */ +int +PEMailboxCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *op, errbuf[256], *err = "Unknown PEMailbox operation"; + + dprint((5, "PEMailboxCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + } + else if((op = Tcl_GetStringFromObj(objv[1], NULL)) != NULL){ + if(!strucmp(op, "open")){ + int i, colid; + char *folder; + CONTEXT_S *cp; + + peED.uid = 0; /* forget cached embedded data */ + + /* + * CMD: open <context-index> <folder> + * + * + */ + if(objc == 2){ + Tcl_SetResult(interp, (!sp_dead_stream(ps_global->mail_stream)) ? "0" : "1", TCL_VOLATILE); + return(TCL_OK); + } + + if(Tcl_GetIntFromObj(interp,objv[2],&colid) != TCL_ERROR){ + if((folder = Tcl_GetStringFromObj(objv[objc - 1], NULL)) != NULL) { + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid) { + if(PEMakeFolderString(interp, cp, objc - 3, objv + 3, + &folder)) + return TCL_ERROR; + + dprint((1, "* PEMailbox open dir=%s folder=%s",cp->dir->ref,folder)); + + return(peCreateStream(interp, cp, folder, FALSE)); + } + + err = "open: Unrecognized collection ID"; + } + else + err = "open: Can't read folder"; + } + else + err = "open: Can't get collection ID"; + } + else if(!strcmp(op, "indexformat")){ + /* + * CMD: indexformat + * + * Returns: list of lists where: + * * the first element is the name of the + * field which may be "From", "Subject" + * "Date" or the emtpy string. + * * the second element which is either + * the percentage width or empty string + */ + if(objc == 2) + return(peIndexFormat(interp)); + } + else if(ps_global && ps_global->mail_stream){ + if(!strcmp(op, "select")){ + return(peSelect(interp, objc - 2, &((Tcl_Obj **) objv)[2], MN_SLCT)); + } + else if(!strcmp(op, "search")){ + return(peSelect(interp, objc - 2, &((Tcl_Obj **) objv)[2], MN_SRCH)); + } + else if(!strucmp(op, "apply")){ + return(peApply(interp, objc - 2, &((Tcl_Obj **) objv)[2])); + } + else if(!strcmp(op, "expunge")){ + /* + * CMD: expunge + * + * Returns: OK after having removed deleted messages + */ + char *streamstr = NULL; + MAILSTREAM *stream; + MSGNO_S *msgmap; + + if(objc == 3) streamstr = Tcl_GetStringFromObj(objv[2], NULL); + if(!streamstr + || (streamstr && (strcmp(streamstr, "current") == 0))){ + stream = ps_global->mail_stream; + msgmap = sp_msgmap(stream); + } + else if(streamstr && (strcmp(streamstr, "inbox") == 0)){ + stream = sp_inbox_stream(); + msgmap = sp_msgmap(stream); + } + else return(TCL_ERROR); + ps_global->last_error[0] = '\0'; + if(IS_NEWS(stream) + && stream->rdonly){ + msgno_exclude_deleted(stream, msgmap); + clear_index_cache(sp_inbox_stream(), 0); + + /* + * This is kind of surprising at first. For most sort + * orders, if the whole set is sorted, then any subset + * is also sorted. Not so for OrderedSubject sort. + * If you exclude the first message of a subject group + * then you change the date that group is to be sorted on. + */ + if(mn_get_sort(msgmap) == SortSubject2) + refresh_sort(ps_global->mail_stream, msgmap, FALSE); + } + else + (void) cmd_expunge_work(stream, msgmap); + + Tcl_SetResult(interp, ps_global->last_error, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "trashdeleted")){ + /* + * CMD: trashdeleted + * + * Returns: OK after moving deleted messages to Trash and expunging + */ + MAILSTREAM *stream; + MESSAGECACHE *mc; + CONTEXT_S *cp; + MSGNO_S *msgmap; + char *streamstr = NULL, tmp[MAILTMPLEN]; + long n, tomove = 0L; + + if(objc == 3) streamstr = Tcl_GetStringFromObj(objv[2], NULL); + if(!streamstr + || (streamstr && (strcmp(streamstr, "current") == 0))){ + stream = ps_global->mail_stream; + msgmap = sp_msgmap(stream); + } + else if(streamstr && (strcmp(streamstr, "inbox") == 0)){ + stream = sp_inbox_stream(); + msgmap = sp_msgmap(stream); + } + else return(TCL_ERROR); + + ps_global->last_error[0] = '\0'; + if(IS_NEWS(stream) && stream->rdonly){ + msgno_exclude_deleted(stream, msgmap); + clear_index_cache(sp_inbox_stream(), 0); + + /* + * This is kind of surprising at first. For most sort + * orders, if the whole set is sorted, then any subset + * is also sorted. Not so for OrderedSubject sort. + * If you exclude the first message of a subject group + * then you change the date that group is to be sorted on. + */ + if(mn_get_sort(msgmap) == SortSubject2) + refresh_sort(ps_global->mail_stream, msgmap, FALSE); + } + else{ + if(!(cp = default_save_context(ps_global->context_list))) + cp = ps_global->context_list; + + /* copy to trash if we're not in trash */ + if(ps_global->VAR_TRASH_FOLDER + && ps_global->VAR_TRASH_FOLDER[0] + && context_allowed(context_apply(tmp, cp, ps_global->VAR_TRASH_FOLDER, sizeof(tmp))) + && !same_stream_and_mailbox(tmp, stream)){ + + /* save real selected set, and */ + for(n = 1L; n <= mn_get_total(msgmap); n++){ + set_lflag(stream, msgmap, n, MN_STMP, get_lflag(stream, msgmap, n, MN_SLCT)); + /* select deleted */ + if(!get_lflag(stream, msgmap, n, MN_EXLD) + && (mc = mail_elt(stream, mn_m2raw(msgmap,n))) != NULL && mc->deleted){ + tomove++; + set_lflag(stream, msgmap, n, MN_SLCT, 1); + } + else + set_lflag(stream, msgmap, n, MN_SLCT, 0); + } + + if(tomove && pseudo_selected(stream, msgmap)){ + + /* save delted to Trash */ + n = save(ps_global, stream, + cp, ps_global->VAR_TRASH_FOLDER, + msgmap, SV_FOR_FILT | SV_FIX_DELS); + + /* then remove them */ + if(n == tomove){ + (void) cmd_expunge_work(stream, msgmap); + } + + restore_selected(msgmap); + } + + /* restore selected set */ + for(n = 1L; n <= mn_get_total(msgmap); n++) + set_lflag(stream, msgmap, n, MN_SLCT, + get_lflag(stream, msgmap, n, MN_STMP)); + } + } + + Tcl_SetResult(interp, ps_global->last_error, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "nextvector")){ + long msgno, count, countdown; + int i, aObjN = 0; + char *errstr = NULL, *s; + Tcl_Obj *rvObj, *vObj, *avObj, **aObj; + + /* + * CMD: nextvector + * + * ARGS: msgno - message number "next" is relative to + * count - how many msgno slots to return + * attrib - (optional) attributes to be returned with each message in vector + * + * Returns: vector containing next <count> messagenumbers (and optional attributes) + */ + if(objc == 4 || objc == 5){ + if(Tcl_GetLongFromObj(interp, objv[2], &msgno) == TCL_OK){ + if(Tcl_GetLongFromObj(interp, objv[3], &count) == TCL_OK){ + + /* set index range for efficiency */ + if(msgno > 0L && msgno <= mn_get_total(sp_msgmap(ps_global->mail_stream))){ + gPeITop = msgno; + gPeICount = count; + } + + if(objc == 4 || Tcl_ListObjGetElements(interp, objv[4], &aObjN, &aObj) == TCL_OK){ + + if((rvObj = Tcl_NewListObj(0, NULL)) != NULL && count > 0 + && !(msgno < 1L || msgno > mn_get_total(sp_msgmap(ps_global->mail_stream)))){ + mn_set_cur(sp_msgmap(ps_global->mail_stream), msgno); + + for(countdown = count; countdown > 0; countdown--){ + imapuid_t uid = mail_uid(ps_global->mail_stream, mn_m2raw(sp_msgmap(ps_global->mail_stream), msgno)); + int fetched = 0; + + if((vObj = Tcl_NewListObj(0, NULL)) != NULL){ + Tcl_ListObjAppendElement(interp, vObj, Tcl_NewLongObj(msgno)); + peAppListF(interp, vObj, "%lu", uid); + + if(aObjN){ + if((avObj = Tcl_NewListObj(0, NULL)) != NULL){ + for(i = 0; i < aObjN; i++){ + if((s = Tcl_GetStringFromObj(aObj[i], NULL)) != NULL){ + if(!strcmp(s, "statusbits")){ + char *s = peMsgStatBitString(ps_global, ps_global->mail_stream, + sp_msgmap(ps_global->mail_stream), peMessageNumber(uid), + gPeITop, gPeICount, &fetched); + Tcl_ListObjAppendElement(interp, avObj, Tcl_NewStringObj(s, -1)); + } + else if(!strcmp(s, "statuslist")){ + Tcl_Obj *nObj = peMsgStatNameList(interp, ps_global, ps_global->mail_stream, + sp_msgmap(ps_global->mail_stream), peMessageNumber(uid), + gPeITop, gPeICount, &fetched); + Tcl_ListObjAppendElement(interp, avObj, nObj); + } + else if(!strcmp(s, "status")){ + long raw; + char stat[3]; + MESSAGECACHE *mc; + + raw = peSequenceNumber(uid); + + if(!((mc = mail_elt(ps_global->mail_stream, raw)) && mc->valid)){ + mail_fetch_flags(ps_global->mail_stream, + ulong2string(uid), FT_UID); + mc = mail_elt(ps_global->mail_stream, raw); + } + + stat[0] = mc->deleted ? '1' : '0'; + stat[1] = mc->recent ? '1' : '0'; + stat[2] = mc->seen ? '1' : '0'; + + Tcl_ListObjAppendElement(interp, avObj, Tcl_NewStringObj(stat,3)); + } + else if(!strcmp(s, "indexparts")){ + Tcl_Obj *iObj; + + if((iObj = Tcl_NewListObj(0, NULL)) != NULL + && peAppendIndexParts(interp, uid, iObj, &fetched) == TCL_OK + && Tcl_ListObjAppendElement(interp, avObj, iObj) == TCL_OK){ + } + else + return(TCL_ERROR); + } + else if(!strucmp(s, "indexcolor")){ + if(peAppendIndexColor(interp, uid, avObj, &fetched) != TCL_OK) + return(TCL_ERROR); + } + } + else{ + errstr = "nextvector: can't read attributes"; + break; + } + } + + Tcl_ListObjAppendElement(interp, vObj, avObj); + } + else{ + errstr = "nextvector: can't allocate attribute return vector"; + break; + } + } + } + else{ + errstr = "nextvector: can't allocate new vector"; + break; + } + + Tcl_ListObjAppendElement(interp, rvObj, vObj); + + for(++msgno; msgno <= mn_get_total(sp_msgmap(ps_global->mail_stream)) && msgline_hidden(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), msgno, MN_NONE); msgno++) + ; + + if(msgno > mn_get_total(sp_msgmap(ps_global->mail_stream))) + break; + } + } + + if(!errstr){ + /* append result vector */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), rvObj); + /* Everything is coerced to UTF-8 */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj("UTF-8", -1)); + return(TCL_OK); + } + } + else + errstr = "nextvector: can't read attribute list"; + } + else + errstr = "nextvector: can't read count"; + } + else + errstr = "nextvector: can't read message number"; + } + else + errstr = "nextvector: Incorrect number of arguments"; + + if(errstr) + Tcl_SetResult(interp, errstr, TCL_STATIC); + + return(TCL_ERROR); + } + else if(objc == 2){ + if(!strcmp(op, "messagecount")){ + /* + * CMD: messagecount + * + * Returns: count of messsages in open mailbox + */ + Tcl_SetResult(interp, + long2string(mn_get_total(sp_msgmap(ps_global->mail_stream))), + TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "firstinteresting")){ + /* + * CMD: firstinteresting + * + * Returns: message number associated with + * "incoming-startup-rule" which had better + * be the "current" message since it was set + * in do_broach_folder and shouldn't have been + * changed otherwise (expunged screw us?) + */ + Tcl_SetResult(interp, + long2string(mn_get_cur(sp_msgmap(ps_global->mail_stream))), + TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "selected")){ + /* + * CMD: selected + * + * Returns: count of selected messsages in open mailbox + */ + + Tcl_SetResult(interp, + long2string(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_SLCT)), + TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "searched")){ + /* + * CMD: searched + * + * Returns: count of searched messsages in open mailbox + */ + + Tcl_SetResult(interp, + long2string(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_SRCH)), + TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "mailboxname")){ + /* + * CMD: name + * + * Returns: string representing the name of the + * current mailbox + */ + Tcl_SetResult(interp, ps_global->cur_folder, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "close")){ + /* + * CMD: close + * + * Returns: with global mail_stream closed + */ + peDestroyStream(ps_global); + return(TCL_OK); + } + else if(!strcmp(op, "newmailreset")){ + sml_seen(); + zero_new_mail_count(); + sp_set_mail_box_changed(ps_global->mail_stream, 0); + sp_set_expunge_count(ps_global->mail_stream, 0L); + peMarkInputTime(); + return(TCL_OK); + } + else if(!strcmp(op, "newmailstatmsg")){ + long newest, count; + char subject[500], subjtxt[500], from[500], intro[500], *s = ""; + + /* + * CMD: newmailstatmsg + * + * ARGS: none + * + * Returns: text for new mail message + * + */ + + if(sp_mail_box_changed(ps_global->mail_stream) + && (count = sp_mail_since_cmd(ps_global->mail_stream))){ + + for(newest = ps_global->mail_stream->nmsgs; newest > 1L; newest--) + if(!get_lflag(ps_global->mail_stream, NULL, newest, MN_EXLD)) + break; + + if(newest){ + format_new_mail_msg(NULL, count, + pine_mail_fetchstructure(ps_global->mail_stream, + newest, NULL), + intro, from, subject, subjtxt, sizeof(subject)); + + snprintf(s = tmp_20k_buf, SIZEOF_20KBUF, "%s %s %s", intro, from, subjtxt); + } + } + + Tcl_SetResult(interp, s, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "savedefault")){ + return(peSaveDefault(interp, 0L, 0, NULL)); + } + else if(!strcmp(op, "gotodefault")){ + return(peGotoDefault(interp, 0L, NULL)); + } + else if(!strcmp(op, "zoom")){ + Tcl_SetResult(interp, + long2string((any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE) > 0L) + ? any_lflagged(sp_msgmap(ps_global->mail_stream), MN_SLCT) : 0L), + TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "focus")){ + Tcl_SetResult(interp, + long2string((any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE) > 0L) + ? any_lflagged(sp_msgmap(ps_global->mail_stream), MN_SRCH) : 0L), + TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "first")){ + if(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE)){ + long n; + + for(n = 1L; n <= mn_get_total(sp_msgmap(ps_global->mail_stream)); n++) + if(!get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_HIDE)){ + Tcl_SetResult(interp, long2string(n), TCL_VOLATILE); + return(TCL_OK); + } + + unzoom_index(ps_global, ps_global->mail_stream, sp_msgmap(ps_global->mail_stream)); + + } + + Tcl_SetResult(interp, int2string(1), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strucmp(op, "current")){ + long n = 0; + unsigned long u = 0; + + /* + * CMD: current + * + * ARGS: + * + * Returns: list of current msg {<sequence> <uid>} + */ + + if(mn_total_cur(sp_msgmap(ps_global->mail_stream)) <= 0 + || ((n = mn_get_cur(sp_msgmap(ps_global->mail_stream))) > 0 + && (u = mail_uid(ps_global->mail_stream, mn_m2raw(sp_msgmap(ps_global->mail_stream), n))) > 0)){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(long2string(n), -1)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(ulong2string(u), -1)); + return(TCL_OK); + } + else + err = "Cannot get current"; + } + else if(!strcmp(op, "last")){ + if(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE)){ + long n; + + for(n = mn_get_total(sp_msgmap(ps_global->mail_stream)); n > 0L; n--) + if(!get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_HIDE)){ + Tcl_SetResult(interp, long2string(n), TCL_VOLATILE); + return(TCL_OK); + } + } + else{ + Tcl_SetResult(interp, long2string(mn_get_total(sp_msgmap(ps_global->mail_stream))), TCL_VOLATILE); + return(TCL_OK); + } + + Tcl_SetResult(interp, "Can't set last message number", TCL_STATIC); + return(TCL_ERROR); + } + else if(!strucmp(op, "sortstyles")){ + int i; + /* + * CMD: sortstyles + * + * Returns: list of supported sort styles + */ + + for(i = 0; ps_global->sort_types[i] != EndofList; i++) + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(sort_name(ps_global->sort_types[i]), -1)) != TCL_OK) + return(TCL_ERROR); + + return(TCL_OK); + } + else if(!strucmp(op, "sort")){ + return(peAppendCurrentSort(interp)); + } + else if(!strucmp(op, "state")){ + if(!ps_global->mail_stream || sp_dead_stream(ps_global->mail_stream)) + Tcl_SetResult(interp, "closed", TCL_STATIC); + else if(ps_global->mail_stream->rdonly && !IS_NEWS(ps_global->mail_stream)) + Tcl_SetResult(interp, "readonly", TCL_STATIC); + else + Tcl_SetResult(interp, "ok", TCL_STATIC); + + return(TCL_OK); + } + else if(!strucmp(op, "excludedeleted")){ + msgno_exclude_deleted(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream)); + return(TCL_OK); + } + } + else if(objc == 3){ + if(!strcmp(op, "uid")){ + long msgno, raw; + + /* + * Return uid of given message number + * + * CMD: uid <msgnumber> + */ + + if(Tcl_GetLongFromObj(interp, objv[2], &msgno) != TCL_OK) + return(TCL_ERROR); /* conversion problem? */ + + if((raw = mn_m2raw(sp_msgmap(ps_global->mail_stream), msgno)) > 0L){ + raw = mail_uid(ps_global->mail_stream, raw); + Tcl_SetResult(interp, long2string(raw), TCL_VOLATILE); + return(TCL_OK); + } + + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Invalid UID for message %ld", msgno); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + else if(!strcmp(op, "newmail")){ + int reload, force = UFU_NONE, rv; + time_t now = time(0); + + /* + * CMD: newmail + * + * ARGS: reload -- "1" if we're reloading + * (vs. just checking newmail as a side effect + * of building a new page) + * + * Returns: count - + * mostrecent - + */ + if(Tcl_GetIntFromObj(interp, objv[2], &reload) == TCL_ERROR) + reload = 0; + + /* minimum 10 second between IMAP pings */ + if(!time_of_last_input() || now - time_of_last_input() > 10){ + force = UFU_FORCE; + peMarkInputTime(); + } + + /* check for new mail */ + new_mail(force, reload ? GoodTime : VeryBadTime, NM_NONE); + + rv = peNewMailResult(interp); + + if(!reload) /* announced */ + zero_new_mail_count(); + + return(rv); + } + else if(!strcmp(op, "flagcount")){ + char *flag; + long count = 0L; + long flags = 0L; + int objlc; + Tcl_Obj **objlv; + + + /* + * CMD: flagcount + * + * ARGS: flags - + * + * Returns: count - number of message thusly flagged + * mostrecent - + */ + if(Tcl_ListObjGetElements(interp, objv[2], &objlc, &objlv) == TCL_OK){ + while(objlc--) + if((flag = Tcl_GetStringFromObj(*objlv++, NULL)) != NULL){ + if(!strucmp(flag, "deleted")){ + flags |= F_DEL; + } + if(!strucmp(flag, "undeleted")){ + flags |= F_UNDEL; + } + else if(!strucmp(flag, "seen")){ + flags |= F_SEEN; + } + else if(!strucmp(flag, "unseen")){ + flags |= F_UNSEEN; + } + else if(!strucmp(flag, "flagged")){ + flags |= F_FLAG; + } + else if(!strucmp(flag, "unflagged")){ + flags |= F_UNFLAG; + } + else if(!strucmp(flag, "answered")){ + flags |= F_ANS; + } + else if(!strucmp(flag, "unanswered")){ + flags |= F_UNANS; + } + else if(!strucmp(flag, "recent")){ + flags |= F_RECENT; + } + else if(!strucmp(flag, "unrecent")){ + flags |= F_UNRECENT; + } + } + + if(flags) + count = count_flagged(ps_global->mail_stream, flags); + } + + Tcl_SetResult(interp, long2string(count), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "zoom")){ + int newstate; + long n, zoomed = 0L; + + /* + * CMD: zoom + * + * Set/clear HID bits of non SLCT messages as requested. + * PEMailbox [first | last | next] are senstive to these flags. + * + * ARGS: newstate - 1 or 0 + * + * Returns: count of zoomed messages + */ + + if(Tcl_GetIntFromObj(interp, objv[2], &newstate) != TCL_ERROR){ + if(newstate > 0){ + if(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE) != (mn_get_total(sp_msgmap(ps_global->mail_stream)) - (n = any_lflagged(sp_msgmap(ps_global->mail_stream), MN_SLCT)))){ + zoom_index(ps_global, ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), MN_SLCT); + zoomed = n; + } + } + else{ + if(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE)) + unzoom_index(ps_global, ps_global->mail_stream, sp_msgmap(ps_global->mail_stream)); + } + } + + Tcl_SetResult(interp, long2string(zoomed), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "focus")){ + int newstate; + long n, zoomed = 0L; + + /* + * CMD: focus + * + * Set/clear HID bits of non MN_SRCH messages as requested. + * PEMailbox [first | last | next] are senstive to MN_HIDE flag + * + * ARGS: newstate - 1 or 0 + * + * Returns: count of zoomed messages + */ + + if(Tcl_GetIntFromObj(interp, objv[2], &newstate) != TCL_ERROR){ + if(newstate > 0){ + if(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE) != (mn_get_total(sp_msgmap(ps_global->mail_stream)) - (n = any_lflagged(sp_msgmap(ps_global->mail_stream), MN_SRCH)))) + zoom_index(ps_global, ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), MN_SRCH); + + zoomed = n; + } + else{ + if(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE)) + unzoom_index(ps_global, ps_global->mail_stream, sp_msgmap(ps_global->mail_stream)); + } + } + + Tcl_SetResult(interp, long2string(zoomed), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(op, "next")){ + long msgno; + + /* + * CMD: next <msgno> + * + * ARGS: msgno - message number "next" is relative to + * + * Returns: previous state + */ + + if(Tcl_GetLongFromObj(interp, objv[2], &msgno) != TCL_ERROR){ + mn_set_cur(sp_msgmap(ps_global->mail_stream), msgno); + mn_inc_cur(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), MH_NONE); + Tcl_SetResult(interp, long2string(mn_get_cur(sp_msgmap(ps_global->mail_stream))), TCL_VOLATILE); + return(TCL_OK); + } + + Tcl_SetResult(interp, "next can't read message number", TCL_STATIC); + return(TCL_ERROR); + } + } + else if(objc == 4){ + if(!strucmp(op, "sort")){ + int i, reversed = 0; + char *sort; + + /* + * CMD: sort sortstyle reversed + * + * Returns: OK with the side-effect of message + * numbers now reflecting the requested + * sort order. + */ + + if((sort = Tcl_GetStringFromObj(objv[2], NULL)) + && Tcl_GetIntFromObj(interp, objv[3], &reversed) != TCL_ERROR){ + /* convert sort string into */ + for(i = 0; ps_global->sort_types[i] != EndofList; i++) + if(strucmp(sort_name(ps_global->sort_types[i]), sort) == 0){ + if(sp_unsorted_newmail(ps_global->mail_stream) + || !(ps_global->sort_types[i] == mn_get_sort(sp_msgmap(ps_global->mail_stream)) + && mn_get_revsort(sp_msgmap(ps_global->mail_stream)) == reversed)) + sort_folder(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), + ps_global->sort_types[i], + reversed, 0); + + break; + } + } + + return(peAppendCurrentSort(interp)); + } + else if(!strucmp(op, "selected")){ + return(peSelected(interp, objc - 2, &((Tcl_Obj **) objv)[2], MN_SLCT)); + } + else if(!strucmp(op, "searched")){ + return(peSelected(interp, objc - 2, &((Tcl_Obj **) objv)[2], MN_SRCH)); + } + else if(!strcmp(op, "next")){ + long msgno, count; + + /* + * CMD: next + * + * ARGS: msgno - message number "next" is relative to + * count - how many to increment it + * + * Returns: previous state + */ + + if(Tcl_GetLongFromObj(interp, objv[2], &msgno) != TCL_ERROR + && Tcl_GetLongFromObj(interp, objv[3], &count) != TCL_ERROR){ + mn_set_cur(sp_msgmap(ps_global->mail_stream), msgno); + while(count) + if(count > 0){ + mn_inc_cur(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), MH_NONE); + count--; + } + else{ + mn_dec_cur(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), MH_NONE); + count++; + } + + Tcl_SetResult(interp, long2string(mn_get_cur(sp_msgmap(ps_global->mail_stream))), TCL_VOLATILE); + return(TCL_OK); + } + + Tcl_SetResult(interp, "next can't read message number", TCL_STATIC); + return(TCL_ERROR); + } + else if(!strcmp(op, "x-nextvector")){ + long msgno, count; + + /* + * CMD: nextvector + * + * ARGS: msgno - message number "next" is relative to + * count - how many msgno slots to return + * + * Returns: vector containing next <count> messagenumbers + */ + + if(Tcl_GetLongFromObj(interp, objv[2], &msgno) != TCL_ERROR + && Tcl_GetLongFromObj(interp, objv[3], &count) != TCL_ERROR){ + if(count > 0 && !(msgno < 1L || msgno > mn_get_total(sp_msgmap(ps_global->mail_stream)))){ + mn_set_cur(sp_msgmap(ps_global->mail_stream), msgno); + + while(count--){ + long n = mn_get_cur(sp_msgmap(ps_global->mail_stream)); + + if(peAppListF(interp, Tcl_GetObjResult(interp), + "%l%l", n, mail_uid(ps_global->mail_stream, + mn_m2raw(sp_msgmap(ps_global->mail_stream), n))) != TCL_OK) + return(TCL_ERROR); + + mn_inc_cur(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), MH_NONE); + + if(n == mn_get_cur(sp_msgmap(ps_global->mail_stream))) + break; + } + } + + return(TCL_OK); + } + + Tcl_SetResult(interp, "next can't read message number", TCL_STATIC); + return(TCL_ERROR); + } + else if(!strcmp(op, "messagecount")){ + char *relative; + long msgno, n, count = 0L; + + /* + * CMD: messagecount + * + * ARGS: [before | after] relative to + * msgno + * + * Returns: count of messsages before or after given message number + */ + + if((relative = Tcl_GetStringFromObj(objv[2], NULL)) + && Tcl_GetLongFromObj(interp, objv[3], &msgno) != TCL_ERROR){ + if(msgno < 1L || msgno > mn_get_total(sp_msgmap(ps_global->mail_stream))){ + Tcl_SetResult(interp, "relative msgno out of range", TCL_STATIC); + return(TCL_ERROR); + } + + if(!strucmp(relative, "before")){ + for(n = msgno - 1; n > 0L; n--) + if(!get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_HIDE)) + count++; + + Tcl_SetResult(interp, long2string(count), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strucmp(relative, "after")){ + for(n = msgno + 1; n <= mn_get_total(sp_msgmap(ps_global->mail_stream)); n++) + if(!get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_HIDE)) + count++; + + Tcl_SetResult(interp, long2string(count), TCL_VOLATILE); + return(TCL_OK); + } + } + + Tcl_SetResult(interp, "can't read range for count", TCL_STATIC); + return(TCL_ERROR); + } + else if(!strcmp(op, "selectvector")){ + long msgno, count; + + /* + * CMD: selectvector + * + * ARGS: msgno - message number "next" is relative to + * count - how many msgno slots to return + * + * Returns: vector containing next <count> messagenumbers + */ + + if(Tcl_GetLongFromObj(interp, objv[2], &msgno) != TCL_ERROR + && Tcl_GetLongFromObj(interp, objv[3], &count) != TCL_ERROR){ + if(msgno > 0L){ + mn_set_cur(sp_msgmap(ps_global->mail_stream), msgno); + while(count--){ + msgno = mn_get_cur(sp_msgmap(ps_global->mail_stream)); + + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), msgno, MN_SLCT)) + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewLongObj((long) mail_uid(ps_global->mail_stream, msgno))) != TCL_OK) + return(TCL_ERROR); + + mn_inc_cur(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), MH_NONE); + + if(msgno == mn_get_cur(sp_msgmap(ps_global->mail_stream))) + break; + } + } + + return(TCL_OK); + } + + Tcl_SetResult(interp, "selectvector: no message number", TCL_STATIC); + return(TCL_ERROR); + } + else if(!strucmp(op, "current")){ + char *which; + long x, n = 0, u = 0; + + /* + * CMD: current + * + * ARGS: (number|uid) <msgno> + * + * Returns: list of current msg {<sequence> <uid>} + */ + if((which = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(Tcl_GetLongFromObj(interp, objv[3], &x) == TCL_OK){ + if(!strucmp(which,"uid")){ + u = x; + n = peMessageNumber(u); + } + else if(!strucmp(which,"number")){ + n = x; + u = mail_uid(ps_global->mail_stream, mn_m2raw(sp_msgmap(ps_global->mail_stream), n)); + } + + if(n && u){ + mn_set_cur(sp_msgmap(ps_global->mail_stream), n); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(long2string(n), -1)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(long2string(u), -1)); + return(TCL_OK); + } + else + err = "PEMailbox current: invalid number/uid"; + } + else + err = "PEMailbox current: cannot get number"; + } + else + err = "PEMailbox current: cannot get which"; + } + } + else + err = "PEMailbox: Too many arguments"; + } + else if(!strucmp(op, "name") || !strcmp(op, "close")){ + Tcl_SetResult(interp, "", TCL_STATIC); + return(TCL_OK); + } + else + snprintf(err = errbuf, sizeof(errbuf), "%s: %s: No open mailbox", + Tcl_GetStringFromObj(objv[0], NULL), op); + } + + Tcl_SetResult(interp, err, TCL_VOLATILE); + return(TCL_ERROR); +} + + +int +peAppendCurrentSort(Tcl_Interp *interp) +{ + return((Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(sort_name(mn_get_sort(sp_msgmap(ps_global->mail_stream))), -1)) == TCL_OK + && Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(mn_get_revsort(sp_msgmap(ps_global->mail_stream)) ? "1" : "0", 1)) == TCL_OK) + ? TCL_OK : TCL_ERROR); +} + + +int +peAppendDefaultSort(Tcl_Interp *interp) +{ + return((Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(sort_name(ps_global->def_sort), -1)) == TCL_OK + && Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ps_global->def_sort_rev ? "1" : "0", 1)) == TCL_OK) + ? TCL_OK : TCL_ERROR); +} + + +int +peSelect(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int matchflag) +{ + char *subcmd; + long n, i, diff, msgno; + int narrow, hidden; + MESSAGECACHE *mc; + extern MAILSTREAM *mm_search_stream; + extern long mm_search_count; + + hidden = any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE) > 0L; + mm_search_stream = ps_global->mail_stream; + mm_search_count = 0L; + + for(n = 1L; n <= ps_global->mail_stream->nmsgs; n++) + if((mc = mail_elt(ps_global->mail_stream, n)) != NULL){ + mc->searched = 0; + mc->spare7 = 1; + } + + /* + * CMD: select + * + * ARGS: subcmd subcmdargs + * + * Returns: flip "matchflag" private bit on all or none + * of the messages in the mailbox + */ + if((subcmd = Tcl_GetStringFromObj(objv[0], NULL)) != NULL){ + if(!strucmp(subcmd, "all")){ + /* + * Args: <none> + */ + if(matchflag & MN_SLCT){ + if(objc != 1) + return(peSelectError(interp, subcmd)); + + agg_select_all(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), NULL, 1); + } + else if(matchflag & MN_SRCH){ + for(n = 1L; n <= ps_global->mail_stream->nmsgs; n++) + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, matchflag, 1); + } + + Tcl_SetResult(interp, "All", TCL_VOLATILE); + } + else if(!strucmp(subcmd, "none")){ + /* + * Args: <none> + */ + n = 0L; + + if(matchflag & MN_SLCT){ + if(objc != 1) + return(peSelectError(interp, subcmd)); + + agg_select_all(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), &n, 0); + } + else if(matchflag & MN_SRCH){ + for(n = 1L; n <= ps_global->mail_stream->nmsgs; n++) + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, matchflag, 0); + } + + Tcl_SetResult(interp, long2string(n), TCL_VOLATILE); + } + else if(!strucmp(subcmd, "searched")){ + /* + * Args: <none> + */ + for(n = 1L, i = 0; n <= ps_global->mail_stream->nmsgs; n++) + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_SRCH)){ + i++; + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_SLCT, 1); + } + + Tcl_SetResult(interp, long2string(i), TCL_VOLATILE); + } + else if(!strucmp(subcmd, "unsearched")){ + /* + * Args: <none> + */ + for(n = 1L, i = 0; n <= ps_global->mail_stream->nmsgs; n++) + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_SRCH)){ + i++; + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), n, MN_SLCT, 0); + } + + Tcl_SetResult(interp, long2string(i), TCL_VOLATILE); + } + else{ + if(!strucmp(subcmd, "narrow")) + narrow = 1; + else if(!strucmp(subcmd, "broad")) + narrow = 0; + else + return(peSelectError(interp, "invalid scope request")); + + if(!(subcmd = Tcl_GetStringFromObj(objv[1], NULL))) + return(peSelectError(interp, "missing subcommand")); + + if(!strucmp(subcmd, "num")){ + if((i = peSelectNumber(interp, objc - 2, &objv[2], matchflag)) != TCL_OK) + return(i); + } + else if(!strucmp(subcmd, "date")){ + if((i = peSelectDate(interp, objc - 2, &objv[2], matchflag)) != TCL_OK) + return(i); + } + else if(!strucmp(subcmd, "text")){ + if((i = peSelectText(interp, objc - 2, &objv[2], matchflag)) != TCL_OK) + return(i); + } + else if(!strucmp(subcmd, "status")){ + if((i = peSelectStatus(interp, objc - 2, &objv[2], matchflag)) != TCL_OK) + return(i); + } + else if(!strucmp(subcmd, "compound")){ + char *s; + int nSearchList, nSearch; + Tcl_Obj **oSearchList, **oSearch; + + /* BUG: should set up one SEARCHPGM to fit criteria and issue single search */ + + if(Tcl_ListObjGetElements(interp, objv[2], &nSearchList, &oSearchList) == TCL_OK){ + for(i = 0; i < nSearchList; i++){ + if(Tcl_ListObjGetElements(interp, oSearchList[i], &nSearch, &oSearch) == TCL_OK){ + if((s = Tcl_GetStringFromObj(oSearch[0], NULL)) != NULL){ + if(!strucmp(s,"date")){ + if((n = peSelectDate(interp, nSearch - 1, &oSearch[1], matchflag)) != TCL_OK) + return(n); + } + else if(!strucmp(s,"text")){ + if((n = peSelectText(interp, nSearch - 1, &oSearch[1], matchflag)) != TCL_OK) + return(n); + } + else if(!strucmp(s,"status")){ + if((n = peSelectStatus(interp, nSearch - 1, &oSearch[1], matchflag)) != TCL_OK) + return(n); + } + else + return(peSelectError(interp, "unknown compound search")); + + /* logical AND the results */ + mm_search_count = 0L; + for(n = 1L; n <= ps_global->mail_stream->nmsgs; n++) + if((mc = mail_elt(ps_global->mail_stream, n)) != NULL){ + if(mc->searched && mc->spare7) + mm_search_count++; + else + mc->searched = mc->spare7 = 0; + } + } + else + return(peSelectError(interp, "malformed compound search")); + } + else + return(peSelectError(interp, "malformed compound search")); + } + } + else + return(peSelectError(interp, "malformed compound search")); + } + else + return(peSelectError(interp, "cmd cmdargs")); + + /* + * at this point all interesting messages should + * have searched bit lit + */ + + if(narrow) /* make sure something was selected */ + for(i = 1L; i <= mn_get_total(sp_msgmap(ps_global->mail_stream)); i++) + if(mail_elt(ps_global->mail_stream, + mn_m2raw(sp_msgmap(ps_global->mail_stream), i))->searched){ + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, matchflag)) + break; + else + mm_search_count--; + } + + diff = 0L; + if(mm_search_count){ + /* + * loop thru all the messages, adjusting local flag bits + * based on their "searched" bit... + */ + for(i = 1L, msgno = 0L; i <= mn_get_total(sp_msgmap(ps_global->mail_stream)); i++) + if(narrow){ + /* turning OFF selectedness if the "searched" bit isn't lit. */ + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, matchflag)){ + if(!mail_elt(ps_global->mail_stream, + mn_m2raw(sp_msgmap(ps_global->mail_stream), i))->searched){ + diff--; + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, matchflag, 0); + if(hidden) + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, MN_HIDE, 1); + } + else if(msgno < mn_get_cur(sp_msgmap(ps_global->mail_stream))) + msgno = i; + } + } + else if(mail_elt(ps_global->mail_stream,mn_m2raw(sp_msgmap(ps_global->mail_stream),i))->searched){ + /* turn ON selectedness if "searched" bit is lit. */ + if(!get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, matchflag)){ + diff++; + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, matchflag, 1); + if(hidden) + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, MN_HIDE, 0); + } + } + + /* if we're zoomed and the current message was unselected */ + if(narrow && msgno + && get_lflag(ps_global->mail_stream,sp_msgmap(ps_global->mail_stream),mn_get_cur(sp_msgmap(ps_global->mail_stream)),MN_HIDE)) + mn_reset_cur(sp_msgmap(ps_global->mail_stream), msgno); + } + + Tcl_SetResult(interp, long2string(diff), TCL_VOLATILE); + } + + return(TCL_OK); + } + + Tcl_SetResult(interp, "Can't read select option", TCL_STATIC); + return(TCL_ERROR); +} + +int +peSelectNumber(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int matchflag) +{ + /* + * Args: [broad | narrow] firstnumber lastnumber + */ + + long first = 0L, last = 0L, n; + + if(objc == 2){ + if(Tcl_GetLongFromObj(interp, objv[0], &first) == TCL_OK + && Tcl_GetLongFromObj(interp, objv[1], &last) == TCL_OK){ + if(last && last < first){ + n = last; + last = first; + first = n; + } + + if(first >= 1L && first <= mn_get_total(sp_msgmap(ps_global->mail_stream))){ + if(last){ + if(last >= 1L && last <= mn_get_total(sp_msgmap(ps_global->mail_stream))){ + for(n = first; n <= last; n++) + mm_searched(ps_global->mail_stream, + mn_m2raw(sp_msgmap(ps_global->mail_stream), n)); + } + else + return(peSelectError(interp, "last out of range")); + } + else{ + mm_searched(ps_global->mail_stream, + mn_m2raw(sp_msgmap(ps_global->mail_stream), first)); + } + } + else + return(peSelectError(interp, "first out of range")); + } + else + return(peSelectError(interp, "can't read first/last")); + } + else + return(peSelectError(interp, "num first last")); + + return(TCL_OK); +} + +int +peSelectDate(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int matchflag) +{ + /* + * Args: [broad | narrow] + * tense - "on", "since", "before" + * year - 4 digit year + * month - abbreviated month "jan", "feb"... + * day - day number + */ + + char *tense, *year, *month, *day, buf[256]; + + if(objc == 4){ + if((tense = peSelValTense(objv[0])) != NULL){ + if((year = peSelValYear(objv[1])) != NULL){ + if((month = peSelValMonth(objv[2])) != NULL){ + if((day = peSelValDay(objv[3])) != NULL){ + snprintf(buf, sizeof(buf), "%s %s-%s-%s", tense, day, month, year); + pine_mail_search_full(ps_global->mail_stream, NULL, + mail_criteria(buf), + SE_NOPREFETCH | SE_FREE); + } + else + return(peSelectError(interp, "<with valid day>")); + } + else + return(peSelectError(interp, "<with valid month>")); + } + else + return(peSelectError(interp, "<with valid year>")); + } + else + return(peSelectError(interp, "<with valid tense>")); + } + else + return(peSelectError(interp, "date tense year monthabbrev daynum")); + + return(TCL_OK); +} + +int +peSelectText(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int matchflag) +{ + /* + * Args: [broad | narrow] + * case - in not + * field - to from cc recip partic subj any + * text - free text search string + */ + int not; + char field, *text; + + if(objc == 3){ + if((not = peSelValCase(objv[0])) >= 0){ + if((field = peSelValField(objv[1])) != '\0'){ + if((text = Tcl_GetStringFromObj(objv[2], NULL)) + && strlen(text) < 1024){ + /* BUG: fix charset not to be NULL below */ + if(agg_text_select(ps_global->mail_stream, + sp_msgmap(ps_global->mail_stream), + field, NULL, not, 0, text, NULL, NULL)) + /* BUG: plug in "charset" above? */ + return(peSelectError(interp, "programmer botch")); + } + else + return(peSelectError(interp, "<with search string < 1024>")); + } + else + return(peSelectError(interp, "<with valid field>")); + } + else + return(peSelectError(interp, "<with valid case>")); + } + else + return(peSelectError(interp, "text case field text")); + + return(TCL_OK); +} + +int +peSelectStatus(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int matchflag) +{ + /* + * Args: [broad | narrow] + * case - on not + * status - imp new ans del + */ + int not; + char flag; + + if(objc == 2){ + if((not = peSelValCase(objv[0])) >= 0){ + if((flag = peSelValFlag(objv[1])) != '\0'){ + if(agg_flag_select(ps_global->mail_stream, not, flag, NULL)) + return(peSelectError(interp, "programmer botch")); + } + else + return(peSelectError(interp, "<with valid flag>")); + } + else + return(peSelectError(interp, "<with valid case>")); + } + else + return(peSelectError(interp, "status focus case flag")); + + return(TCL_OK); +} + +char * +peSelValTense(Tcl_Obj *objp) +{ + char *tense, **pp; + + if((tense = Tcl_GetStringFromObj(objp, NULL)) != NULL){ + static char *tenses[] = {"on", "since", "before", NULL}; + + for(pp = tenses; *pp; pp++) + if(!strucmp(*pp, tense)) + return(tense); + } + + return(NULL); +} + + +char * +peSelValYear(Tcl_Obj *objp) +{ + char *year; + + return((year = Tcl_GetStringFromObj(objp, NULL)) + && strlen(year) == 4 + && isdigit((unsigned char) year[0]) + && isdigit((unsigned char) year[0]) + && isdigit((unsigned char) year[0]) + ? year + : NULL); +} + + +char * +peSelValMonth(Tcl_Obj *objp) +{ + char *month, **pp; + static char *mons[] = {"jan","feb","mar","apr", + "may","jun","jul","aug", + "sep","oct","nov","dec", NULL}; + + if((month = Tcl_GetStringFromObj(objp, NULL)) && strlen(month) == 3) + for(pp = mons; *pp; pp++) + if(!strucmp(month, *pp)) + return(*pp); + + return(NULL); +} + + +char * +peSelValDay(Tcl_Obj *objp) +{ + char *day; + + return(((day = Tcl_GetStringFromObj(objp, NULL)) + && (day[0] == '0' || day[0] == '1' + || day[0] == '2' || day[0] == '3') + && isdigit((unsigned char) day[1]) + && day[2] == '\0') + ? day + : NULL); +} + + +int +peSelValCase(Tcl_Obj *objp) +{ + char *not; + + if((not = Tcl_GetStringFromObj(objp, NULL)) != NULL){ + if(!strucmp(not, "ton")) + return(0); + else if(!strucmp(not, "not")) + return(1); + } + + return(-1); +} + + +int +peSelValField(Tcl_Obj *objp) +{ + char *field; + int i; + static struct { + char *field; + int type; + } fields[] = {{"from", 'f'}, + {"to", 't'}, + {"cc", 'c'}, + {"subj", 's'}, + {"any", 'a'}, + {"recip", 'r'}, + {"partic", 'p'}, + {"body", 'b'}, + {NULL,0}}; + + if((field = Tcl_GetStringFromObj(objp, NULL)) != NULL) + for(i = 0; fields[i].field ; i++) + if(!strucmp(fields[i].field, field)) + return(fields[i].type); + + return(0); +} + + +int +peSelValFlag(Tcl_Obj *objp) +{ + char *flag; + int i; + static struct { + char *flag; + int type; + } flags[] = {{"imp", '*'}, + {"new", 'n'}, + {"ans", 'a'}, + {"del", 'd'}, + {NULL,0}}; + + if((flag = Tcl_GetStringFromObj(objp, NULL)) != NULL) + for(i = 0; flags[i].flag ; i++) + if(!strucmp(flags[i].flag, flag)) + return(flags[i].type); + + return(0); +} + +int +peSelected(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int matchflag) +{ + int rv = 0; + long i, n; + char *range; + + /* + * CMD: searched [before | after] # + * + * Returns: 1 if criteria is true, 0 otherwise + */ + + if((range = Tcl_GetStringFromObj(objv[0], NULL)) + && Tcl_GetLongFromObj(interp, objv[1], &n) != TCL_ERROR){ + if(!strucmp(range, "before")){ + for(i = 1L; i < n && i <= mn_get_total(sp_msgmap(ps_global->mail_stream)); i++) + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, matchflag)){ + rv = 1; + break; + } + + Tcl_SetResult(interp, int2string(rv), TCL_STATIC); + return(TCL_OK); + } + else if(!strucmp(range, "after")){ + for(i = n + 1L; i <= mn_get_total(sp_msgmap(ps_global->mail_stream)); i++) + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), i, matchflag)){ + rv = 1; + break; + } + + Tcl_SetResult(interp, int2string(rv), TCL_STATIC); + return(TCL_OK); + } + } + + Tcl_SetResult(interp, "searched test failed", TCL_STATIC); + return(TCL_ERROR); +} + + +int +peSelectError(Tcl_Interp *interp, char *usage) +{ + char buf[256]; + + snprintf(buf, sizeof(buf), "should be select %.128s", usage); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); +} + + +int +peApply(Tcl_Interp *interp, int objc, Tcl_Obj **objv) +{ + char *subcmd; + long n; + + if(!(n = any_lflagged(sp_msgmap(ps_global->mail_stream), MN_SLCT))){ + Tcl_SetResult(interp, "No messages selected", TCL_STATIC); + return(TCL_ERROR); + } + else if((subcmd = Tcl_GetStringFromObj(objv[0], NULL)) != NULL){ + if(objc == 1){ + if(!strucmp(subcmd, "delete")){ + /* BUG: is CmdWhere arg always right? */ + (void) cmd_delete(ps_global, sp_msgmap(ps_global->mail_stream), MCMD_AGG | MCMD_SILENT, NULL); + Tcl_SetResult(interp, long2string(n), TCL_STATIC); + return(TCL_OK); + } + else if(!strucmp(subcmd, "undelete")){ + (void) cmd_undelete(ps_global, sp_msgmap(ps_global->mail_stream), MCMD_AGG | MCMD_SILENT); + Tcl_SetResult(interp, long2string(n), TCL_STATIC); + return(TCL_OK); + } + } + else if(objc == 2){ + if(!strucmp(subcmd, "count")){ + /* + * Args: flag + */ + char *flagname; + long n, rawno, count = 0; + + if((flagname = Tcl_GetStringFromObj(objv[1], NULL)) != NULL){ + for(n = 1L; n <= mn_get_total(sp_msgmap(ps_global->mail_stream)); n++){ + rawno = mn_m2raw(sp_msgmap(ps_global->mail_stream), n); + if(get_lflag(ps_global->mail_stream, NULL, rawno, MN_SLCT) + && peIsFlagged(ps_global->mail_stream, + mail_uid(ps_global->mail_stream, rawno), + flagname)){ + count++; + } + } + } + + Tcl_SetResult(interp, long2string(count), TCL_VOLATILE); + return(TCL_OK); + } + } + else if(objc == 3){ + if(!strucmp(subcmd, "flag")){ + /* + * Args: case - on not + * flag - imp new ans del + */ + char flag, *result; + int not; + long flagged; + + if((not = peSelValCase(objv[1])) >= 0){ + if((flag = peSelValFlag(objv[2])) != '\0'){ + result = peApplyFlag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), flag, not, &flagged); + if(!result){ + Tcl_SetResult(interp, int2string(flagged), TCL_VOLATILE); + return(TCL_OK); + } + else + return(peApplyError(interp, result)); + } + else + return(peApplyError(interp, "invalid flag")); + } + else + return(peApplyError(interp, "invalid case")); + } + else if(!strucmp(subcmd, "save")){ + /* + * Args: colid - + * folder - imp new ans del + */ + + int colid, flgs = 0, i; + char *folder, *err; + CONTEXT_S *cp; + + if(Tcl_GetIntFromObj(interp, objv[1], &colid) != TCL_ERROR){ + + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid){ + if((folder = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(pseudo_selected(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream))){ + + if(!READONLY_FOLDER(ps_global->mail_stream) + && F_OFF(F_SAVE_WONT_DELETE, ps_global)) + flgs |= SV_DELETE; + + if(colid == 0 && !strucmp(folder, "inbox")) + flgs |= SV_INBOXWOCNTXT; + + i = save(ps_global, ps_global->mail_stream, + cp, folder, sp_msgmap(ps_global->mail_stream), flgs); + + err = (i == mn_total_cur(sp_msgmap(ps_global->mail_stream))) ? NULL : "problem saving"; + + restore_selected(sp_msgmap(ps_global->mail_stream)); + if(err) + return(peApplyError(interp, err)); + + Tcl_SetResult(interp, long2string(i), TCL_VOLATILE); + return(TCL_OK); + } + else + return(peApplyError(interp, "can't select")); + } + else + return(peApplyError(interp, "no folder name")); + } + + return(peApplyError(interp, "bad colid")); + } + else + return(peApplyError(interp, "invalid case")); + } + else if(!strucmp(subcmd, "copy")){ + /* + * Args: colid - + * folder - imp new ans del + */ + + int colid, flgs = 0, i; + char *folder, *err; + CONTEXT_S *cp; + + if(Tcl_GetIntFromObj(interp, objv[1], &colid) != TCL_ERROR){ + + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid){ + if((folder = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(pseudo_selected(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream))){ + + if(colid == 0 && !strucmp(folder, "inbox")) + flgs |= SV_INBOXWOCNTXT; + + i = save(ps_global, ps_global->mail_stream, + cp, folder, sp_msgmap(ps_global->mail_stream), flgs); + + err = (i == mn_total_cur(sp_msgmap(ps_global->mail_stream))) ? NULL : "problem copying"; + + restore_selected(sp_msgmap(ps_global->mail_stream)); + if(err) + return(peApplyError(interp, err)); + + Tcl_SetResult(interp, long2string(i), TCL_VOLATILE); + return(TCL_OK); + } + else + return(peApplyError(interp, "can't select")); + } + else + return(peApplyError(interp, "no folder name")); + } + + return(peApplyError(interp, "bad colid")); + } + else + return(peApplyError(interp, "invalid case")); + } + else if(!strucmp(subcmd, "move")){ + /* + * Args: colid - + * folder - imp new ans del + */ + + int colid, flgs = 0, i; + char *folder, *err; + CONTEXT_S *cp; + + if(Tcl_GetIntFromObj(interp, objv[1], &colid) != TCL_ERROR){ + + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid){ + if((folder = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(pseudo_selected(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream))){ + + flgs = SV_DELETE; + + if(colid == 0 && !strucmp(folder, "inbox")) + flgs |= SV_INBOXWOCNTXT; + + i = save(ps_global, ps_global->mail_stream, + cp, folder, sp_msgmap(ps_global->mail_stream), flgs); + + err = (i == mn_total_cur(sp_msgmap(ps_global->mail_stream))) ? NULL : "problem moving"; + + restore_selected(sp_msgmap(ps_global->mail_stream)); + if(err) + return(peApplyError(interp, err)); + + Tcl_SetResult(interp, long2string(i), TCL_VOLATILE); + return(TCL_OK); + } + else + return(peApplyError(interp, "can't select")); + } + else + return(peApplyError(interp, "no folder name")); + } + + return(peApplyError(interp, "bad colid")); + } + else + return(peApplyError(interp, "invalid case")); + } + else if(!strucmp(subcmd, "spam")){ + /* + * Args: spamaddr - + * spamsubj - + */ + char *spamaddr, *spamsubj = NULL; + long n, rawno; + + if((spamaddr = Tcl_GetStringFromObj(objv[1], NULL)) + && (spamsubj = Tcl_GetStringFromObj(objv[2], NULL))){ + for(n = 1L; n <= mn_get_total(sp_msgmap(ps_global->mail_stream)); n++){ + rawno = mn_m2raw(sp_msgmap(ps_global->mail_stream), n); + if(get_lflag(ps_global->mail_stream, NULL, rawno, MN_SLCT)){ + char errbuf[WP_MAX_POST_ERROR + 1], *rs = NULL; + + if((rs = peSendSpamReport(rawno, spamaddr, spamsubj, errbuf)) != NULL){ + Tcl_SetResult(interp, rs, TCL_VOLATILE); + return(TCL_ERROR); + } + } + } + } + + Tcl_SetResult(interp, "OK", TCL_VOLATILE); + return(TCL_OK); + } + } + } + + return(peApplyError(interp, "unknown option")); +} + + +char * +peApplyFlag(MAILSTREAM *stream, MSGNO_S *msgmap, char flag, int not, long *flagged) +{ + char *seq, *flagstr; + long flags, flagid; + + switch (flag) { + case '*' : + flagstr = "\\FLAGGED"; + flags = not ? 0L : ST_SET; + flagid = not ? F_FLAG : F_UNFLAG; + break; + case 'n' : + flagstr = "\\SEEN"; + flags = not ? ST_SET : 0L; + flagid = not ? F_UNSEEN : F_SEEN; + break; + case 'a' : + flagstr = "\\ANSWERED"; + flags = not ? 0L : ST_SET; + flagid = not ? F_ANS : F_UNANS; + break; + case 'd': + flagstr = "\\DELETED"; + flags = not ? 0L : ST_SET; + flagid = not ? F_DEL : F_UNDEL; + break; + default : + return("unknown flag"); + break; + } + + if(pseudo_selected(stream, msgmap)){ + if((seq = currentf_sequence(stream, msgmap, flagid, flagged, 1, NULL, NULL)) != NULL){ + mail_flag(stream, seq, flagstr, flags); + fs_give((void **) &seq); + } + + restore_selected(msgmap); + return(NULL); + } + else + return("can't select"); +} + + +int +peApplyError(Tcl_Interp *interp, char *usage) +{ + char buf[256]; + + snprintf(buf, sizeof(buf), "apply error: %.128s", usage); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); +} + + +/* + * peIndexFormat - Return with interp's result object set to + * represent the index line's format as a list of + * index-field-name, percentage-width pairs + */ +int +peIndexFormat(Tcl_Interp *interp) +{ + INDEX_COL_S *cdesc = NULL; + char *name, wbuf[4], *dname; + + for(cdesc = ps_global->index_disp_format; + cdesc->ctype != iNothing; + cdesc++) { + dname = NULL; + switch(cdesc->ctype){ + case iFStatus: + case iIStatus: + case iSIStatus: + dname = "iStatus"; + case iStatus: + name = "Status"; + break; + + case iMessNo: + name = "Number"; + break; + + case iPrio: + case iPrioAlpha: + case iPrioBang: + name = "Priority"; + break; + + case iDate: case iSDate: case iSTime: case iLDate: + case iS1Date: case iS2Date: case iS3Date: case iS4Date: case iDateIso: + case iDateIsoS: + case iSDateIso: case iSDateIsoS: + case iSDateS1: case iSDateS2: + case iSDateS3: case iSDateS4: + case iSDateTime: + case iSDateTimeIso: case iSDateTimeIsoS: + case iSDateTimeS1: case iSDateTimeS2: + case iSDateTimeS3: case iSDateTimeS4: + case iSDateTime24: + case iSDateTimeIso24: case iSDateTimeIsoS24: + case iSDateTimeS124: case iSDateTimeS224: + case iSDateTimeS324: case iSDateTimeS424: + case iCurDate: case iCurDateIso: case iCurDateIsoS: + case iCurTime24: case iCurTime12: + case iCurPrefDate: + name = "Date"; + break; + + case iCurDay: case iCurDay2Digit: + case iCurDayOfWeek: case iCurDayOfWeekAbb: + name = "Day"; + break; + + case iCurMon: case iCurMon2Digit: + case iCurMonLong: case iCurMonAbb: + name= "Month"; + break; + + case iTime24: case iTime12: case iTimezone: + case iCurPrefTime: + name = "Time"; + break; + + case iDay2Digit: case iDayOfWeek: case iDayOfWeekAbb: + name = "Day"; + break; + + case iMonAbb: case iMon2Digit: + name = "Month"; + break; + + case iYear: case iYear2Digit: + case iCurYear: case iCurYear2Digit: + name = "Year"; + break; + + case iScore : + name = "Score"; + break; + + case iFromTo: + case iFromToNotNews: + case iFrom: + name = "From"; + break; + + case iTo: + case iToAndNews : + name = "To"; + break; + + case iCc: + name = "Cc"; + break; + + case iRecips: + name = "Recipients"; + break; + + case iSender: + name = "Sender"; + break; + + case iSize : + case iSizeComma : + case iSizeNarrow : + case iDescripSize: + case iKSize : + name = "Size"; + break; + + case iAtt: + name = "Attachments"; + break; + + case iAddress : + name = "Address"; + break; + + case iMailbox : + name = "Mailbox"; + break; + + case iSubject : + case iSubjKey : + case iSubjKeyInit : + case iSubjectText : + case iSubjKeyText : + case iSubjKeyInitText : + name = "Subject"; + break; + + case iNews: + case iNewsAndTo : + name = "News"; + break; + + case iNewsAndRecips: + name = "News/Recip"; + break; + + case iRecipsAndNews: + name = "Recip/News"; + break; + + default : + name = ""; + break; + } + + if(cdesc->width > 0){ + int p = ((cdesc->width * 100) / FAKE_SCREEN_WIDTH); + + snprintf(wbuf, sizeof(wbuf), "%d%%", p); + } + else + wbuf[0] = '\0'; + + if(peAppListF(interp, Tcl_GetObjResult(interp), "%s%s%s", name, wbuf, dname) != TCL_OK) + return(TCL_ERROR); + } + + return(TCL_OK); +} + + +int +peNewMailResult(Tcl_Interp *interp) +{ + unsigned long n, uid; + + if(sp_mail_box_changed(ps_global->mail_stream)){ + if((n = sp_mail_since_cmd(ps_global->mail_stream)) != 0L){ + /* first element is count of new messages */ + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewLongObj(n)) != TCL_OK) + return(TCL_ERROR); + + /* second element is UID of most recent message */ + for(uid = ps_global->mail_stream->nmsgs; uid > 1L; uid--) + if(!get_lflag(ps_global->mail_stream, NULL, uid, MN_EXLD)) + break; + + if(!uid){ + Tcl_ResetResult(interp); + Tcl_SetResult(interp, "0 0 0", TCL_STATIC); + return(TCL_ERROR); + } + + uid = mail_uid(ps_global->mail_stream, uid); + + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewLongObj(uid)) != TCL_OK) + return(TCL_ERROR); + } + else { + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewIntObj(0)) != TCL_OK) + return(TCL_ERROR); + + /* zero is UID of new message */ + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewIntObj(0)) != TCL_OK) + return(TCL_ERROR); + } + + /* third element is expunge count */ + if(Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewLongObj(sp_expunge_count(ps_global->mail_stream) + ? sp_expunge_count(ps_global->mail_stream) + : 0L)) != TCL_OK) + return(TCL_ERROR); + + } + else + Tcl_SetResult(interp, "0 0 0", TCL_STATIC); + + return(TCL_OK); +} + + +/* * * * * * * * Start of Per-Thread/SubThread access functions * * * * * * * */ + + +/* + * PEThreadCmd - access/manipulate various pieces of thread state + */ +int +PEThreadCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *err, errbuf[256], *cmd, *op; + imapuid_t uid; + + dprint((2, "PEThreadCmd")); + + snprintf(err = errbuf, sizeof(errbuf), "Unknown %s request", + Tcl_GetStringFromObj(objv[0], NULL)); + + if(!(ps_global && ps_global->mail_stream)){ + snprintf(err = errbuf, sizeof(errbuf), "%s: No open mailbox", + Tcl_GetStringFromObj(objv[0], NULL)); + } + else if(objc < 2){ + Tcl_WrongNumArgs(interp, 1, objv, "uid cmd ?args?"); + } + else if(Tcl_GetLongFromObj(interp, objv[1], &uid) != TCL_OK){ + return(TCL_ERROR); /* conversion problem? */ + } + else if(!peSequenceNumber(uid)){ + snprintf(err = errbuf, sizeof(errbuf), "%s: UID %ld doesn't exist", + Tcl_GetStringFromObj(objv[0], NULL), uid); + } + else if((cmd = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(objc == 3){ + if(!strucmp(cmd,"info")){ +#define WP_MAX_THRD_PREFIX 256 + long raw; + PINETHRD_S *pthrd; + char tstr[WP_MAX_THRD_PREFIX]; + + if((raw = peSequenceNumber(uid)) != 0L){ + /* + * translate PINETHRD_S data into + */ + if((pthrd = msgno_thread_info(ps_global->mail_stream, raw, NULL, THD_TOP)) != NULL){ + + tstr[0] = '\0'; +/* BUG: build tstr form pthrd */ + + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(tstr, -1)); + } + } + else + Tcl_SetResult(interp, "0", TCL_STATIC); + + return(TCL_OK); + } + + } + else if(objc == 5){ + if(!strucmp(cmd,"flag")){ + if((op = Tcl_GetStringFromObj(objv[3], NULL)) != NULL){ + if(!strucmp(op,"deleted")){ + int value; + + if(Tcl_GetIntFromObj(interp, objv[4], &value) != TCL_ERROR){ + long n; + PINETHRD_S *pthrd; + char *flag; + + while(1){ + if(!(n = peSequenceNumber(uid))){ + Tcl_SetResult(interp, "Unrecognized UID", TCL_STATIC); + return(TCL_ERROR); + } + + flag = cpystr("\\DELETED"); + mail_flag(ps_global->mail_stream, long2string(n), flag, (value ? ST_SET : 0L)); + fs_give((void **) &flag); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(ulong2string(uid), -1)); + + if(++n <= ps_global->mail_stream->nmsgs){ + uid = mail_uid(ps_global->mail_stream, n); + } + else + break; + + if((pthrd = msgno_thread_info(ps_global->mail_stream, n, NULL,THD_TOP)) != NULL){ + } + else + break; + } + } + } + } + } + } + } + + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + + +/* * * * * * * * Start of Per-Message access functions * * * * * * * */ + + + +static struct _message_cmds { + char *cmd; + int hcount; + struct { + int argcount; + int (*f)(Tcl_Interp *, imapuid_t, int, Tcl_Obj **); + } h[3]; +} message_cmds[] = { + {"size", 1, {{3, peMessageSize}}}, + {"date", 2, {{3, peMessageDate}, {4, peMessageDate}}}, + {"subject", 1, {{3, peMessageSubject}}}, + {"fromaddr", 1, {{3, peMessageFromAddr}}}, + {"toaddr", 1, {{3, peMessageToAddr}}}, + {"ccaddr", 1, {{3, peMessageCcAddr}}}, + {"status", 1, {{3, peMessageStatus}}}, + {"statusbits", 1, {{3, peMessageStatusBits}}}, + {"charset", 1, {{3, peMessageCharset}}}, + {"number", 1, {{3, peMsgnoFromUID}}}, + {"envelope", 0}, + {"rawenvelope", 0}, + {"text", 1, {{3, peMessageText}}}, + {"header", 1, {{3, peMessageHeader}}}, + {"attachments", 1, {{3, peMessageAttachments}}}, + {"body", 3, {{3, peMessageBody}, {4, peMessageBody}}}, + {"cid", 1, {{4, peMessagePartFromCID}}}, + {"flag", 2, {{4, peGetFlag}, {5, peSetFlag}}}, + {"replyheaders", 2, {{3, peReplyHeaders},{4, peReplyHeaders}}}, + {"replytext", 2, {{4, peReplyText}, {5, peReplyText}}}, + {"forwardheaders", 2, {{3, peForwardHeaders}, {4, peForwardHeaders}}}, + {"forwardtext", 2, {{3, peForwardText}, {4, peForwardText}}}, + {"rawbody", 0}, + {"select", 2, {{3, peMsgSelect}, {4, peMsgSelect}}}, + {"detach", 1, {{5, peDetach}}}, + {"attachinfo", 1, {{4, peAttachInfo}}}, + {"savedefault", 1, {{3, peSaveDefault}}}, + {"save", 1, {{5, peSave}}}, + {"copy", 1, {{5, peCopy}}}, + {"move", 1, {{5, peMove}}}, + {"takeaddr", 1, {{3, peTakeaddr}}}, + {"takefrom", 1, {{3, peTakeFrom}}}, + {"replyquote", 1, {{3, peReplyQuote}}}, + {"bounce", 2, {{4, peMessageBounce},{5, peMessageBounce}}}, + {"spam", 1, {{5, peMessageSpamNotice}}}, + {"needpasswd", 1, {{3, peMessageNeedPassphrase}}}, + {NULL, 0} +}; + + + + +/* + * PEMessageCmd - export various bits of message information + * + * NOTE: all exported commands are of the form: + * + * PEMessage <uid> <cmd> <args> + */ +int +PEMessageCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *err, errbuf[256], *cmd; + int i, j; + imapuid_t uid; + + dprint((5, "PEMessageCmd")); + + snprintf(err = errbuf, sizeof(errbuf), "Unknown %s request", + Tcl_GetStringFromObj(objv[0], NULL)); + + if(!(ps_global && ps_global->mail_stream)){ + snprintf(err = errbuf, sizeof(errbuf), "%s: No open mailbox", + Tcl_GetStringFromObj(objv[0], NULL)); + } + else if(objc < 3){ + Tcl_WrongNumArgs(interp, 0, objv, "PEMessage <uid> cmd ?args?"); + } + else if(Tcl_GetLongFromObj(interp, objv[1], &uid) != TCL_OK){ + return(TCL_ERROR); /* conversion problem? */ + } + else if(!peMessageNumber(uid)){ + snprintf(err = errbuf, sizeof(errbuf), "%s: UID %ld doesn't exist", + Tcl_GetStringFromObj(objv[0], NULL), uid); + } + else if((cmd = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + for(i = 0; message_cmds[i].cmd; i++) + if(!strcmp(cmd, message_cmds[i].cmd)){ + for(j = 0; j < message_cmds[i].hcount; j++) + if(message_cmds[i].h[j].argcount == objc) + return((*message_cmds[i].h[j].f)(interp, uid, objc - 3, + &((Tcl_Obj **)objv)[3])); + + snprintf(err = errbuf, sizeof(errbuf), + "PEMessage: %s: mismatched argument count", cmd); + break; + } + } + + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + +/* + * return the uid's ordinal number within the CURRENT SORT + */ +long +peMessageNumber(imapuid_t uid) +{ + return(mn_raw2m(sp_msgmap(ps_global->mail_stream), peSequenceNumber(uid))); +} + +/* + * return the uid's RAW message number (for c-client reference, primarily) + */ +long +peSequenceNumber(imapuid_t uid) +{ + return(mail_msgno(ps_global->mail_stream, uid)); +} + + +int +peMessageSize(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + long raw; + + if((raw = peSequenceNumber(uid)) + && pine_mail_fetchstructure(ps_global->mail_stream, raw, NULL)){ + Tcl_SetResult(interp, + long2string(mail_elt(ps_global->mail_stream, + raw)->rfc822_size), + TCL_VOLATILE); + } + else + Tcl_SetResult(interp, "0", TCL_STATIC); + + return(TCL_OK); +} + + +int +peMessageDate(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *cmd; + long raw; + ENVELOPE *env; + MESSAGECACHE mc; + + if((raw = peSequenceNumber(uid)) + && (env = pine_mail_fetchstructure(ps_global->mail_stream, raw, NULL))){ + if(objc == 1 && objv[0]){ + if(mail_parse_date(&mc, env->date)){ + if((cmd = Tcl_GetStringFromObj(objv[0], NULL)) != NULL){ + if(!strucmp(cmd,"day")){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%02d", mc.day); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strucmp(cmd,"month")){ + Tcl_SetResult(interp, month_abbrev(mc.month), TCL_VOLATILE); + return(TCL_OK); + } + else if(!strucmp(cmd,"year")){ + Tcl_SetResult(interp, int2string(mc.year + BASEYEAR), TCL_VOLATILE); + return(TCL_OK); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "peMessageDate cmd: %.20s", cmd); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + } + } + else + Tcl_SetResult(interp, "peMessageDate: can't get command", TCL_STATIC); + } + else + Tcl_SetResult(interp, "peMessageDate: can't parse date", TCL_STATIC); + } + else{ + Tcl_SetResult(interp, env->date ? (char *) env->date : "", TCL_VOLATILE); + return(TCL_OK); + } + } + else + Tcl_SetResult(interp, "Can't get message structure", TCL_STATIC); + + return(TCL_ERROR); +} + + +int +peMessageFromAddr(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + return(peMessageField(interp, uid, "from")); +} + + +int +peMessageToAddr(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + return(peMessageField(interp, uid, "to")); +} + + +int +peMessageCcAddr(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + return(peMessageField(interp, uid, "cc")); +} + + +int +peMessageSubject(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + return(peMessageField(interp, uid, "subject")); +} + + +int +peMessageField(Tcl_Interp *interp, imapuid_t uid, char *field) +{ + long raw; + char *s = ""; + ENVELOPE *env; + + if((raw = peSequenceNumber(uid)) + && (env = pine_mail_fetchstructure(ps_global->mail_stream, raw, NULL))){ + if(!strucmp(field, "from")){ + if(env->from && env->from->mailbox) + snprintf(s = tmp_20k_buf, SIZEOF_20KBUF, "%.256s%s%.256s", env->from->mailbox, + (env->from->host) ? "@" : "", (env->from->host) ? env->from->host : ""); + } + else if(!strucmp(field, "to")){ + if(env->to && env->to->mailbox) + snprintf(s = tmp_20k_buf, SIZEOF_20KBUF, "%.256s%s%.256s", env->to->mailbox, + (env->to->host) ? "@" : "", (env->to->host) ? env->to->host : ""); + } + else if(!strucmp(field, "cc")){ + if(env->cc && env->cc->mailbox) + snprintf(s = tmp_20k_buf, SIZEOF_20KBUF, "%.256s%s%.256s", env->cc->mailbox, + (env->cc->host) ? "@" : "", (env->cc->host) ? env->cc->host : ""); + } + else if(!strucmp(field, "subject")){ + if(env->subject) + snprintf(s = tmp_20k_buf, SIZEOF_20KBUF, "%.256s", env->subject); + } + else{ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Unknown message field: %.20s", field); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + Tcl_SetResult(interp, s, TCL_VOLATILE); + return(TCL_OK); + } + + Tcl_SetResult(interp, "Can't read message envelope", TCL_STATIC); + return(TCL_ERROR); +} + + +int +peMessageStatus(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + long raw; + MESSAGECACHE *mc; + + if((raw = peSequenceNumber(uid)) != 0L){ + if(!((mc = mail_elt(ps_global->mail_stream, raw)) + && mc->valid)){ + mail_fetch_flags(ps_global->mail_stream, + ulong2string(uid), FT_UID); + mc = mail_elt(ps_global->mail_stream, raw); + } + + if (mc->deleted) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj("Deleted", -1)); + + if (mc->answered) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj("Answered", -1)); + + if (!mc->seen) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj("New", -1)); + + if (mc->flagged) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj("Important", -1)); + } + + return(TCL_OK); +} + + +int +peMessageCharset(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + /* everthing coming out of pith better be utf-8 */ + Tcl_SetResult(interp, "UTF-8", TCL_STATIC); + return(TCL_OK); +} + + +int +peMessageNeedPassphrase(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ +#ifdef SMIME + return((ps_global && ps_global->smime && ps_global->smime->need_passphrase) ? TCL_OK : TCL_ERROR); +#else + return(TCL_ERROR); +#endif /* SMIME */ +} + + +int +peMsgnoFromUID(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + Tcl_SetResult(interp, long2string(peMessageNumber(uid)), TCL_VOLATILE); + return(TCL_OK); +} + + +/* + * peInterpWritec - collect filtered output, appending to the + * command's result list on each EOL + */ +int +peInterpWritec(int c) +{ + unsigned char ch = (unsigned char) (0xff & c); + + if(ch == '\n') + return(peInterpFlush() == TCL_OK); + else + so_writec(ch, peED.store); + + return(1); +} + + +/* + * peInterpFlush - write accumulated line to result object mapping + * embedded data into exportable tcl list members + * + */ +int +peInterpFlush(void) +{ + char *line, *p, *tp, *tp2, col1[32], col2[32]; + Tcl_Obj *lobjp, *objColor, *objPair; + + line = (char *) so_text(peED.store); + + if((lobjp = Tcl_NewListObj(0, NULL)) != NULL){ + if((p = strindex(line, TAG_EMBED)) != NULL){ + do{ + *p = '\0'; + + if(p - line) + peAppListF(peED.interp, lobjp, "%s%s", "t", line); + + switch(*++p){ + case TAG_HANDLE : + { + int i, n; + HANDLE_S *h; + + + for(n = 0, i = *++p; i > 0; i--) + n = (n * 10) + (*++p - '0'); + + line = ++p; /* prepare for next section of line */ + + if(!peED.inhandle){ + peED.inhandle = 1; + + if((h = get_handle(peED.handles, n)) != NULL) + switch(h->type){ + case IMG : + { + Tcl_Obj *llObj, *rObj; + + llObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, llObj, Tcl_NewStringObj("img", -1)); + + rObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, rObj, Tcl_NewStringObj(h->h.img.src ? h->h.img.src : "", -1)); + Tcl_ListObjAppendElement(peED.interp, rObj, Tcl_NewStringObj(h->h.img.alt ? h->h.img.alt : "", -1)); + + Tcl_ListObjAppendElement(peED.interp, llObj, rObj); + + Tcl_ListObjAppendElement(peED.interp, lobjp, llObj); + peED.inhandle = 0; + } + + break; + + case URL : + { + Tcl_Obj *llObj, *rObj; + + llObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, llObj, Tcl_NewStringObj("urlstart", -1)); + + rObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, rObj, Tcl_NewStringObj(h->h.url.path ? h->h.url.path : "", -1)); + Tcl_ListObjAppendElement(peED.interp, rObj, Tcl_NewStringObj(h->h.url.name ? h->h.url.name : "", -1)); + + Tcl_ListObjAppendElement(peED.interp, llObj, rObj); + + Tcl_ListObjAppendElement(peED.interp, lobjp, llObj); + } + + break; + + case Attach : + { + Tcl_Obj *alObj, *rObj, *tObj, *stObj, *fnObj, *eObj; + + alObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, alObj, Tcl_NewStringObj("attach", -1)); + + peGetMimeTyping(mail_body(ps_global->mail_stream, + peSequenceNumber(peED.uid), + (unsigned char *) h->h.attach->number), + &tObj, &stObj, &fnObj, &eObj); + + + rObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, rObj, Tcl_NewLongObj(peED.uid)); + Tcl_ListObjAppendElement(peED.interp, rObj, Tcl_NewStringObj(h->h.attach->number, -1)); + Tcl_ListObjAppendElement(peED.interp, rObj, tObj); + Tcl_ListObjAppendElement(peED.interp, rObj, stObj); + Tcl_ListObjAppendElement(peED.interp, rObj, fnObj); + Tcl_ListObjAppendElement(peED.interp, rObj, eObj); + + Tcl_ListObjAppendElement(peED.interp, alObj, rObj); + + Tcl_ListObjAppendElement(peED.interp, lobjp, alObj); + } + + break; + + default : + break; + } + } + } + + break; + + case TAG_FGCOLOR : + if((tp = peColorStr(++p, col1)) && (strcmp(tp, peED.color.fg) || strcmp(tp, peED.color.fgdef))){ + /* look ahead */ + if(p[11] == TAG_EMBED + && p[12] == TAG_BGCOLOR + && (tp2 = peColorStr(p + 13, col2))){ + objColor = Tcl_NewListObj(0, NULL); + objPair = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, objColor, Tcl_NewStringObj("color", -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(tp, -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(tp2, -1)); + Tcl_ListObjAppendElement(peED.interp, objColor, objPair); + Tcl_ListObjAppendElement(peED.interp, lobjp, objColor); + strcpy(peED.color.bg, tp2); + p += 13; + } + else if(strcmp(peED.color.bg, peED.color.bgdef)){ + objColor = Tcl_NewListObj(0, NULL); + objPair = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, objColor, Tcl_NewStringObj("color", -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(tp, -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(peED.color.bgdef, -1)); + Tcl_ListObjAppendElement(peED.interp, objColor, objPair); + Tcl_ListObjAppendElement(peED.interp, lobjp, objColor); + strcpy(peED.color.bg, peED.color.bgdef); + } + else + peAppListF(peED.interp, lobjp, "%s%s", "fgcolor", tp); + + strcpy(peED.color.fg, tp); + } + + line = p + 11; + break; + + case TAG_BGCOLOR : + if((tp = peColorStr(++p, col1)) && (strcmp(tp, peED.color.bg) || strcmp(tp, peED.color.bgdef))){ + /* look ahead */ + if(p[11] == TAG_EMBED + && p[12] == TAG_FGCOLOR + && (tp2 = peColorStr(p + 13, col2))){ + objColor = Tcl_NewListObj(0, NULL); + objPair = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, objColor, Tcl_NewStringObj("color", -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(tp2, -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(tp, -1)); + Tcl_ListObjAppendElement(peED.interp, objColor, objPair); + Tcl_ListObjAppendElement(peED.interp, lobjp, objColor); + strcpy(peED.color.fg, tp2); + p += 13; + } + else if(strcmp(peED.color.fg, peED.color.fgdef)){ + objColor = Tcl_NewListObj(0, NULL); + objPair = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(peED.interp, objColor, Tcl_NewStringObj("color", -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(peED.color.fgdef, -1)); + Tcl_ListObjAppendElement(peED.interp, objPair, Tcl_NewStringObj(tp, -1)); + Tcl_ListObjAppendElement(peED.interp, objColor, objPair); + Tcl_ListObjAppendElement(peED.interp, lobjp, objColor); + strcpy(peED.color.fg, peED.color.fgdef); + } + else + peAppListF(peED.interp, lobjp, "%s%s", "bgcolor", tp); + + strcpy(peED.color.bg, tp); + } + + line = p + 11; + break; + + case TAG_ITALICON : + peAppListF(peED.interp, lobjp, "%s%s", "italic", "on"); + line = p + 1; + break; + + case TAG_ITALICOFF : + peAppListF(peED.interp, lobjp, "%s%s", "italic", "off"); + line = p + 1; + break; + + case TAG_BOLDON : + peAppListF(peED.interp, lobjp, "%s%s", "bold", "on"); + line = p + 1; + break; + + case TAG_BOLDOFF : + peAppListF(peED.interp, lobjp, "%s%s", "bold", "off"); + line = p + 1; + break; + + case TAG_ULINEON : + peAppListF(peED.interp, lobjp, "%s%s", "underline", "on"); + line = p + 1; + break; + + case TAG_ULINEOFF : + peAppListF(peED.interp, lobjp, "%s%s", "underline", "off"); + line = p + 1; + break; + + case TAG_STRIKEON : + peAppListF(peED.interp, lobjp, "%s%s", "strikethru", "on"); + line = p + 1; + break; + + case TAG_STRIKEOFF : + peAppListF(peED.interp, lobjp, "%s%s", "strikethru", "off"); + line = p + 1; + break; + + case TAG_BIGON : + peAppListF(peED.interp, lobjp, "%s%s", "bigfont", "on"); + line = p + 1; + break; + + case TAG_BIGOFF : + peAppListF(peED.interp, lobjp, "%s%s", "bigfont", "off"); + line = p + 1; + break; + + case TAG_SMALLON : + peAppListF(peED.interp, lobjp, "%s%s", "smallfont", "on"); + line = p + 1; + break; + + case TAG_SMALLOFF : + peAppListF(peED.interp, lobjp, "%s%s", "smallfont", "off"); + line = p + 1; + break; + + case TAG_INVOFF : + case TAG_HANDLEOFF : + if(peED.inhandle){ + peAppListF(peED.interp, lobjp, "%s%s", "urlend", ""); + peED.inhandle = 0; + } + /* fall thru and advance "line" */ + + default : + line = p + 1; + break; + } + + } + while((p = strindex(line, TAG_EMBED)) != NULL); + + if(*line) + peAppListF(peED.interp, lobjp, "%s%s", "t", line); + } + else + peAppListF(peED.interp, lobjp, "%s%s", "t", line); + } + else + peAppListF(peED.interp, lobjp, "%s%s", "t", ""); + + if(Tcl_ListObjAppendElement(peED.interp, peED.obj, lobjp) == TCL_OK){ + so_truncate(peED.store, 0L); + return(TCL_OK); + } + + return(TCL_ERROR); +} + + + +/* + * peInterpWritec - collect filtered output, appending to the + * command's result list on each EOL + */ +int +peNullWritec(int c) +{ + return(1); +} + + +char * +peColorStr(char *s, char *b) +{ + int i, j, color; + + i = 0; + b[0] = '\0'; + while(1){ + color = 0; + for(j = 0; j < 3; j++, s++) + if(isdigit((unsigned char) *s)) + color = (color * 10) + (*s - '0'); + + s++; /* advance past ',' */ + if(color < 256) + sprintf(b + strlen(b), "%2.2x", color); + else + break; + + if(++i == 3) + return(b); + } + + + return(NULL); +} + + +/* + * returns a list of elements + */ +int +peMessageHeader(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + MESSAGECACHE *mc; + HEADER_S h; + int flags, rv = TCL_OK; + long raw; +#if 0 + char *color; +#endif + + /* + * ONLY full header mode (raw) output should get written to the + * writec function we pass format_header. If there's something + * in the store after formatting ,we'll write it to the Tcl result + * then, not as its accumulated + */ + peED.interp = interp; + peED.obj = Tcl_NewStringObj("", -1); + + if(peED.store) + so_seek(peED.store, 0L, 0); + else + peED.store = so_get(CharStar, NULL, EDIT_ACCESS); + + flags = FM_DISPLAY | FM_NEW_MESS | FM_NOEDITORIAL | FM_NOHTMLREL | FM_HTMLRELATED; + +#if 0 + peED.color.fg[0] = '\0'; + if((color = pico_get_last_fg_color()) && (color = color_to_asciirgb(color))){ + peInterpWritec(TAG_EMBED); + peInterpWritec(TAG_FGCOLOR); + gf_puts(color, peInterpWritec); + strcpy(peED.color.fgdef, peColorStr(color, tmp_20k_buf)); + } + + peED.color.bg[0] = '\0'; + if((color = pico_get_last_bg_color()) && (color = color_to_asciirgb(color))){ + peInterpWritec(TAG_EMBED); + peInterpWritec(TAG_BGCOLOR); + gf_puts(color, peInterpWritec); + strcpy(peED.color.bgdef, peColorStr(color,tmp_20k_buf)); + } + + peInterpFlush(); +#endif + + raw = peSequenceNumber(uid); + if(peED.uid != uid){ + peED.uid = uid; + peED.body = NULL; + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + if(!((peED.env = pine_mail_fetchstructure(ps_global->mail_stream, raw, &peED.body)) + && (mc = mail_elt(ps_global->mail_stream, raw)))){ + char buf[256]; + + snprintf(buf, sizeof(buf), "Error getting message %ld: %s", peMessageNumber(uid), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate"); + + dprint((1, "ERROR fetching %s of msg %ld: %s", + peED.env ? "elt" : "env", mn_get_cur(sp_msgmap(ps_global->mail_stream)), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate")); + + Tcl_SetResult(interp, buf, TCL_VOLATILE); + rv = TCL_ERROR; + } + else{ + zero_atmts(ps_global->atmts); +#ifdef SMIME + if(ps_global && ps_global->smime && ps_global->smime->need_passphrase) + ps_global->smime->need_passphrase = 0; + + fiddle_smime_message(peED.body, raw); +#endif + describe_mime(peED.body, "", 1, 1, 0, flags); + } + } + + /* NO HANDLES init_handles(&peED.handles);*/ + + /* + * Collect header pieces into lists via the passed custom formatter. Collect + * everything else in the storage object passed. The latter should only end up + * with raw header data. + * + * BUG: DEAL WITH COLORS + */ + if(rv == TCL_OK){ + HD_INIT(&h, ps_global->VAR_VIEW_HEADERS, ps_global->view_all_except, FE_DEFAULT); + if(format_header(ps_global->mail_stream, raw, NULL, peED.env, &h, + NULL, NULL, flags, peFormatEnvelope, peInterpWritec) != 0){ + char buf[256]; + + snprintf(buf, sizeof(buf), "Error formatting header %ld", peMessageNumber(uid)); + dprint((1, buf)); + + Tcl_SetResult(interp, buf, TCL_VOLATILE); + rv = TCL_ERROR; + } + } + + peInterpFlush(); + peAppListF(peED.interp, Tcl_GetObjResult(peED.interp), "%s%s%o", "raw", "", peED.obj); + + so_give(&peED.store); + return(rv); +} + +void +peFormatEnvelope(MAILSTREAM *s, long int n, char *sect, ENVELOPE *e, gf_io_t pc, long int which, char *oacs, int flags) +{ + char *p2, buftmp[MAILTMPLEN]; + Tcl_Obj *objHdr; + + if(!e) + return; + + if((which & FE_DATE) && e->date) { + if((objHdr = Tcl_NewListObj(0, NULL)) != NULL){ + snprintf(buftmp, sizeof(buftmp), "%s", (char *) e->date); + buftmp[sizeof(buftmp)-1] = '\0'; + p2 = (char *)rfc1522_decode_to_utf8((unsigned char *) tmp_20k_buf, SIZEOF_20KBUF, buftmp); + peFormatEnvelopeText("Date", p2); + } + /* BUG: how does error feedback bubble back up? */ + } + + if((which & FE_FROM) && e->from) + peFormatEnvelopeAddress(s, n, sect, "From", e->from, flags, oacs, pc); + + if((which & FE_REPLYTO) && e->reply_to && (!e->from || !address_is_same(e->reply_to, e->from))) + peFormatEnvelopeAddress(s, n, sect, "Reply-To", e->reply_to, flags, oacs, pc); + + if((which & FE_TO) && e->to) + peFormatEnvelopeAddress(s, n, sect, "To", e->to, flags, oacs, pc); + + if((which & FE_CC) && e->cc) + peFormatEnvelopeAddress(s, n, sect, "Cc", e->cc, flags, oacs, pc); + + if((which & FE_BCC) && e->bcc) + peFormatEnvelopeAddress(s, n, sect, "Bcc", e->bcc, flags, oacs, pc); + + if((which & FE_RETURNPATH) && e->return_path) + peFormatEnvelopeAddress(s, n, sect, "Return-Path", e->return_path, flags, oacs, pc); + + if((which & FE_NEWSGROUPS) && e->newsgroups) + peFormatEnvelopeNewsgroups("Newsgroups", e->newsgroups, flags, pc); + + if((which & FE_FOLLOWUPTO) && e->followup_to) + peFormatEnvelopeNewsgroups("Followup-To", e->followup_to, flags, pc); + + if((which & FE_SUBJECT) && e->subject && e->subject[0]){ + if((objHdr = Tcl_NewListObj(0, NULL)) != NULL){ + char *freeme = NULL; + + p2 = iutf8ncpy((char *)(tmp_20k_buf+10000), + (char *)rfc1522_decode_to_utf8((unsigned char *)tmp_20k_buf, 10000, e->subject), + SIZEOF_20KBUF-10000); + + if(flags & FM_DISPLAY + && (ps_global->display_keywords_in_subject + || ps_global->display_keywordinits_in_subject)){ + + /* don't bother if no keywords are defined */ + if(some_user_flags_defined(s)) + p2 = freeme = prepend_keyword_subject(s, n, p2, + ps_global->display_keywords_in_subject ? KW : KWInit, + NULL, ps_global->VAR_KW_BRACES); + } + + peFormatEnvelopeText("Subject", p2); + + if(freeme) + fs_give((void **) &freeme); + } + } + + if((which & FE_SENDER) && e->sender && (!e->from || !address_is_same(e->sender, e->from))) + peFormatEnvelopeAddress(s, n, sect, "Sender", e->sender, flags, oacs, pc); + + if((which & FE_MESSAGEID) && e->message_id){ + p2 = iutf8ncpy((char *)(tmp_20k_buf+10000), (char *)rfc1522_decode_to_utf8((unsigned char *)tmp_20k_buf, 10000, e->message_id), SIZEOF_20KBUF-10000); + peFormatEnvelopeText("Message-ID", p2); + } + + if((which & FE_INREPLYTO) && e->in_reply_to){ + p2 = iutf8ncpy((char *)(tmp_20k_buf+10000), (char *)rfc1522_decode_to_utf8((unsigned char *)tmp_20k_buf, 10000, e->in_reply_to), SIZEOF_20KBUF-10000); + peFormatEnvelopeText("In-Reply-To", p2); + } + + if((which & FE_REFERENCES) && e->references) { + p2 = iutf8ncpy((char *)(tmp_20k_buf+10000), (char *)rfc1522_decode_to_utf8((unsigned char *)tmp_20k_buf, 10000, e->references), SIZEOF_20KBUF-10000); + peFormatEnvelopeText("References", p2); + } +} + + +/* + * appends caller's result with: {"text" field_name {field_value}} + */ +void +peFormatEnvelopeText(char *field_name, char *field_value) +{ + peAppListF(peED.interp, Tcl_GetObjResult(peED.interp), "%s%s%s", "text", field_name, field_value); +} + + +/* + * appends caller's result with: {"addr" field_name {{{personal} {mailbox}} ... }} + * {"rawaddr" field_name {{raw_address} ... }} + */ +void +peFormatEnvelopeAddress(MAILSTREAM *stream, long int msgno, char *section, char *field_name, + struct mail_address *addr, int flags, char *oacs, gf_io_t pc) +{ + char *ptmp, *mtmp, *atype = "addr"; + int group = 0; + ADDRESS *atmp; + Tcl_Obj *objAddrList = NULL; + STORE_S *tso; + gf_io_t tpc; + extern const char *rspecials; + extern const char *rspecials_minus_quote_and_dot; + + if(!addr) + return; + + /* + * quickly run down address list to make sure none are patently bogus. + * If so, just blat raw field out. + */ + for(atmp = addr; stream && atmp; atmp = atmp->next) + if(atmp->host && atmp->host[0] == '.'){ + char *field, *fields[2]; + + atype = "rawaddr"; + if((objAddrList = Tcl_NewListObj(0,NULL)) == NULL) + return; /* BUG: handle list creation failure */ + + fields[1] = NULL; + fields[0] = cpystr(field_name); + if((ptmp = strchr(fields[0], ':')) != NULL) + *ptmp = '\0'; + + if((field = pine_fetchheader_lines(stream, msgno, section, fields)) != NULL){ + char *h, *t; + + for(t = h = field; *h ; t++) + if(*t == '\015' && *(t+1) == '\012'){ + *t = '\0'; /* tie off line */ + + Tcl_ListObjAppendElement(peED.interp, objAddrList, Tcl_NewStringObj(h,-1)); + + if(!*(h = (++t) + 1)) /* set new h and skip CRLF */ + break; /* no more to write */ + } + else if(!*t){ /* shouldn't happen much */ + if(h != t) + Tcl_ListObjAppendElement(peED.interp, objAddrList, Tcl_NewStringObj(h,-1)); + + break; + } + + fs_give((void **)&field); + } + + fs_give((void **)&fields[0]); + } + + if(!objAddrList){ + if((objAddrList = Tcl_NewListObj(0,NULL)) == NULL || (tso = so_get(CharStar, NULL, EDIT_ACCESS)) == NULL) + return; /* BUG: handle list creation failure */ + + gf_set_so_writec(&tpc, tso); + + while(addr){ + + atmp = addr->next; /* remember what's next */ + addr->next = NULL; + if(!addr->host && addr->mailbox){ + mtmp = addr->mailbox; + addr->mailbox = cpystr((char *)rfc1522_decode_to_utf8( + (unsigned char *)tmp_20k_buf, + SIZEOF_20KBUF, addr->mailbox)); + } + + ptmp = addr->personal; /* RFC 1522 personal name? */ + addr->personal = iutf8ncpy((char *)tmp_20k_buf, (char *)rfc1522_decode_to_utf8((unsigned char *)(tmp_20k_buf+10000), SIZEOF_20KBUF-10000, addr->personal), 10000); + tmp_20k_buf[10000-1] = '\0'; + + + /* Logic taken from: pine_rfc822_write_address_noquote(addr, pc, &group); */ + if (addr->host) { /* ordinary address? */ + if (!(addr->personal || addr->adl)){ + so_seek(tso, 0L, 0); + pine_rfc822_address (addr, tpc); + peAppListF(peED.interp, objAddrList, "%s%o", "", Tcl_NewStringObj((char *) so_text(tso), so_tell(tso))); + } + else { /* no, must use phrase <route-addr> form */ + Tcl_Obj *objTmp; + + if (addr->personal){ + so_seek(tso, 0L, 0); + pine_rfc822_cat (addr->personal, rspecials_minus_quote_and_dot, tpc); + objTmp = Tcl_NewStringObj((char *) so_text(tso), so_tell(tso)); + } + + so_seek(tso, 0L, 0); + pine_rfc822_address(addr, tpc); + peAppListF(peED.interp, objAddrList, "%o%o", objTmp, Tcl_NewStringObj((char *) so_text(tso), so_tell(tso))); + } + + if(group) + group++; + } + else if (addr->mailbox) { /* start of group? */ + so_seek(tso, 0L, 0); + /* yes, write group name */ + pine_rfc822_cat (addr->mailbox, rspecials, tpc); + peAppListF(peED.interp, objAddrList, "%o%s", Tcl_NewStringObj((char *) so_text(tso), so_tell(tso)), ""); + group = 1; /* in a group */ + } + else if (group) { /* must be end of group (but be paranoid) */ + peAppListF(peED.interp, objAddrList, "%s%s", "", ";"); + group = 0; /* no longer in that group */ + } + + addr->personal = ptmp; /* restore old personal ptr */ + if(!addr->host && addr->mailbox){ + fs_give((void **)&addr->mailbox); + addr->mailbox = mtmp; + } + + addr->next = atmp; + addr = atmp; + } + + gf_clear_so_writec(tso); + so_give(&tso); + } + + peAppListF(peED.interp, Tcl_GetObjResult(peED.interp), "%s%s%o", atype, field_name, objAddrList); +} + + +/* + * appends caller's result with: {"news" field_name {{newsgroup1} {newsgroup2} ... }} + */ +void +peFormatEnvelopeNewsgroups(char *field_name, char *newsgrps, int flags, gf_io_t pc) +{ + char buf[MAILTMPLEN]; + int llen; + char *next_ng; + Tcl_Obj *objNewsgroups; + + /* BUG: handle list creation failure */ + if(!newsgrps || !*newsgrps || (objNewsgroups = Tcl_NewListObj(0,NULL)) == NULL) + return; + + llen = strlen(field_name); + while(*newsgrps){ + for(next_ng = newsgrps; *next_ng && *next_ng != ','; next_ng++) + ; + + strncpy(buf, newsgrps, MIN(next_ng - newsgrps, sizeof(buf)-1)); + buf[MIN(next_ng - newsgrps, sizeof(buf)-1)] = '\0'; + + Tcl_ListObjAppendElement(peED.interp, objNewsgroups, Tcl_NewStringObj(buf,-1)); + + newsgrps = next_ng; + if(*newsgrps) + newsgrps++; + } + + peAppListF(peED.interp, Tcl_GetObjResult(peED.interp), "news", field_name, objNewsgroups); +} + + +int +peMessageAttachments(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + MESSAGECACHE *mc; + ATTACH_S *a; + BODY *body; + Tcl_Obj *objAtt, *tObj, *stObj, *fnObj; + int flags, rv = TCL_OK; + long raw; + + peED.interp = interp; + peED.obj = Tcl_GetObjResult(interp); + + flags = FM_DISPLAY | FM_NEW_MESS | FM_NOEDITORIAL | FM_HTML | FM_NOHTMLREL | FM_HTMLRELATED | FM_HIDESERVER; + + raw = peSequenceNumber(uid); + + if(peED.uid != uid){ + memset(&peED, 0, sizeof(peED)); + + peED.uid = uid; + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + if(!((peED.env = pine_mail_fetchstructure(ps_global->mail_stream, raw, &peED.body)) + && (mc = mail_elt(ps_global->mail_stream, raw)))){ + char buf[256]; + + snprintf(buf, sizeof(buf), "Error getting message %ld: %s", peMessageNumber(uid), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate"); + + dprint((1, "ERROR fetching %s of msg %ld: %s", + peED.env ? "elt" : "env", mn_get_cur(sp_msgmap(ps_global->mail_stream)), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate")); + + Tcl_SetResult(interp, buf, TCL_VOLATILE); + rv = TCL_ERROR; + } + else{ + zero_atmts(ps_global->atmts); +#ifdef SMIME + if(ps_global && ps_global->smime && ps_global->smime->need_passphrase) + ps_global->smime->need_passphrase = 0; + + fiddle_smime_message(peED.body, raw); +#endif + describe_mime(peED.body, "", 1, 1, 0, flags); + } + } + + /* package up attachment list */ + for(a = ps_global->atmts; rv == TCL_OK && a->description != NULL; a++) + if((objAtt = Tcl_NewListObj(0, NULL)) != NULL + && (body = mail_body(ps_global->mail_stream, raw, (unsigned char *) a->number)) != NULL){ + peGetMimeTyping(body, &tObj, &stObj, &fnObj, NULL); + + if(!(peAppListF(interp, objAtt, "%s", a->number ? a->number : "") == TCL_OK + && peAppListF(interp, objAtt, "%s", a->shown ? "shown" : "") == TCL_OK + && Tcl_ListObjAppendElement(interp, objAtt, tObj) == TCL_OK + && Tcl_ListObjAppendElement(interp, objAtt, stObj) == TCL_OK + && Tcl_ListObjAppendElement(interp, objAtt, fnObj) == TCL_OK + && peAppListF(interp, objAtt, "%s", a->body->description) == TCL_OK + && Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objAtt) == TCL_OK)) + rv = TCL_ERROR; + } + else + rv = TCL_ERROR; + + return(rv); +} + + +int +peMessageBody(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + MESSAGECACHE *mc; + int flags, rv = TCL_OK; + long raw; + char *color; + + peED.interp = interp; + peED.obj = Tcl_GetObjResult(interp); + + if(peED.store) + so_seek(peED.store, 0L, 0); + else + peED.store = so_get(CharStar, NULL, EDIT_ACCESS); + + flags = FM_DISPLAY | FM_NEW_MESS | FM_NOEDITORIAL | FM_NOHTMLREL | FM_HTMLRELATED; + + if(objc == 1 && objv[0]){ /* flags */ + int i, nFlags; + Tcl_Obj **objFlags; + char *flagstr; + + Tcl_ListObjGetElements(interp, objv[0], &nFlags, &objFlags); + for(i = 0; i < nFlags; i++){ + if((flagstr = Tcl_GetStringFromObj(objFlags[i], NULL)) == NULL){ + rv = TCL_ERROR; + } + + if(!strucmp(flagstr, "html")) + flags |= (FM_HTML | FM_HIDESERVER); + else if(!strucmp(flagstr, "images")) + flags |= (FM_HTMLIMAGES); + } + } + + peED.color.fg[0] = '\0'; + if((color = pico_get_last_fg_color()) && (color = color_to_asciirgb(color))){ + peInterpWritec(TAG_EMBED); + peInterpWritec(TAG_FGCOLOR); + gf_puts(color, peInterpWritec); + strcpy(peED.color.fgdef, peColorStr(color, tmp_20k_buf)); + } + + peED.color.bg[0] = '\0'; + if((color = pico_get_last_bg_color()) && (color = color_to_asciirgb(color))){ + peInterpWritec(TAG_EMBED); + peInterpWritec(TAG_BGCOLOR); + gf_puts(color, peInterpWritec); + strcpy(peED.color.bgdef, peColorStr(color,tmp_20k_buf)); + } + + peInterpFlush(); + + init_handles(&peED.handles); + + raw = peSequenceNumber(uid); + + if(peED.uid != uid){ + peED.uid = uid; + peED.body = NULL; + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + if(!((peED.env = pine_mail_fetchstructure(ps_global->mail_stream, raw, &peED.body)) + && (mc = mail_elt(ps_global->mail_stream, raw)))){ + char buf[256]; + + snprintf(buf, sizeof(buf), "Error getting message %ld: %s", peMessageNumber(uid), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate"); + + dprint((1, "ERROR fetching %s of msg %ld: %s", + peED.env ? "elt" : "env", mn_get_cur(sp_msgmap(ps_global->mail_stream)), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate")); + + Tcl_SetResult(interp, buf, TCL_VOLATILE); + rv = TCL_ERROR; + } + else{ + zero_atmts(ps_global->atmts); +#ifdef SMIME + if(ps_global && ps_global->smime && ps_global->smime->need_passphrase) + ps_global->smime->need_passphrase = 0; + + fiddle_smime_message(peED.body, raw); +#endif + describe_mime(peED.body, "", 1, 1, 0, flags); + } + } + + /* format message body */ + if(rv == TCL_OK){ + HEADER_S h; + char *errstr; + + HD_INIT(&h, ps_global->VAR_VIEW_HEADERS, ps_global->view_all_except, FE_DEFAULT); +#ifdef SMIME + /* kind of a hack, the description maybe shouldn't be in the editorial stuff */ + if(ps_global->smime && ps_global->smime->need_passphrase) + flags &= ~FM_NOEDITORIAL; +#endif + if((errstr = format_body(raw, peED.body, &peED.handles, &h, flags, FAKE_SCREEN_WIDTH, peInterpWritec)) != NULL){ + gf_puts(errstr, peInterpWritec); + rv = TCL_ERROR; + } + } + + peInterpFlush(); + + so_give(&peED.store); + free_handles(&peED.handles); + return(rv); +} + + +int +peMessageText(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + MESSAGECACHE *mc; + ENVELOPE *env; + BODY *body; + int flags; + long raw; + char *color; + + memset(&peED, 0, sizeof(peED)); + peED.interp = interp; + peED.obj = Tcl_GetObjResult(interp); + peED.store = so_get(CharStar, NULL, EDIT_ACCESS); + + peED.color.fg[0] = '\0'; + if((color = pico_get_last_fg_color()) && (color = color_to_asciirgb(color))){ + peInterpWritec(TAG_EMBED); + peInterpWritec(TAG_FGCOLOR); + gf_puts(color, peInterpWritec); + strcpy(peED.color.fgdef, peColorStr(color, tmp_20k_buf)); + } + + peED.color.bg[0] = '\0'; + if((color = pico_get_last_bg_color()) && (color = color_to_asciirgb(color))){ + peInterpWritec(TAG_EMBED); + peInterpWritec(TAG_BGCOLOR); + gf_puts(color, peInterpWritec); + strcpy(peED.color.bgdef, peColorStr(color,tmp_20k_buf)); + } + + raw = peSequenceNumber(peED.uid = uid); + body = NULL; + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + if(!((env = pine_mail_fetchstructure(ps_global->mail_stream, raw, &body)) + && (mc = mail_elt(ps_global->mail_stream, raw)))){ + char buf[256]; + + snprintf(buf, sizeof(buf), "Error getting message %ld: %s", peMessageNumber(uid), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate"); + + dprint((1, "ERROR fetching %s of msg %ld: %s", + env ? "elt" : "env", mn_get_cur(sp_msgmap(ps_global->mail_stream)), + ps_global->last_error[0] ? ps_global->last_error : "Indeterminate")); + + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + flags = FM_DISPLAY | FM_NEW_MESS | FM_NOEDITORIAL | FM_NOHTMLREL | FM_HTMLRELATED; + + init_handles(&peED.handles); + + (void) format_message(raw, env, body, &peED.handles, flags, peInterpWritec); + + peInterpFlush(); + + so_give(&peED.store); + free_handles(&peED.handles); + return(TCL_OK); +} + + +/* + * peMessagePartFromCID - return part number assoc'd with given uid and CID + */ +int +peMessagePartFromCID(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *cid, sect_buf[256]; + long raw; + ENVELOPE *env; + BODY *body; + + raw = peSequenceNumber(peED.uid = uid); + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + + if(objv[0] && (cid = Tcl_GetStringFromObj(objv[0], NULL)) && *cid != '\0'){ + if((env = pine_mail_fetchstructure(ps_global->mail_stream, raw, &body)) != NULL){ + sect_buf[0] = '\0'; + if(peLocateBodyByCID(cid, sect_buf, body)){ + Tcl_SetResult(interp, sect_buf, TCL_VOLATILE); + } + } + else{ + Tcl_SetResult(interp, ps_global->last_error[0] ? ps_global->last_error : "Error getting CID", TCL_VOLATILE); + return(TCL_ERROR); + } + } + + return(TCL_OK); +} + + +int +peLocateBodyByCID(char *cid, char *section, BODY *body) +{ + if(body->type == TYPEMULTIPART){ + char subsection[256], *subp; + int n; + PART *part = body->nested.part; + + if(!(part = body->nested.part)) + return(0); + + subp = subsection; + if(section && *section){ + for(n = 0; + n < sizeof(subsection)-20 && (*subp = section[n]); n++, subp++) + ; + + *subp++ = '.'; + } + + n = 1; + do { + sprintf(subp, "%d", n++); + if(peLocateBodyByCID(cid, subsection, &part->body)){ + strcpy(section, subsection); + return(1); + } + } + while((part = part->next) != NULL); + + return(0); + } + + return((body && body->id) ? !strcmp(cid, body->id) : 0); +} + + +/* + * peGetFlag - Return 1 or 0 based on requested flags current state + * + * Params: argv[0] == flagname + */ +int +peGetFlag(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *flagname; + + Tcl_SetResult(interp, + int2string(((flagname = Tcl_GetStringFromObj(objv[0], NULL)) != NULL) + ? peIsFlagged(ps_global->mail_stream, uid, flagname) + : 0), + TCL_VOLATILE); + return(TCL_OK); +} + + +int +peIsFlagged(MAILSTREAM *stream, imapuid_t uid, char *flagname) +{ + MESSAGECACHE *mc; + long raw = peSequenceNumber(uid); + + if(!((mc = mail_elt(stream, raw)) && mc->valid)){ + mail_fetch_flags(stream, ulong2string(uid), FT_UID); + mc = mail_elt(stream, raw); + } + + if(!strucmp(flagname, "deleted")) + return(mc->deleted); + + if(!strucmp(flagname, "new")) + return(!mc->seen); + + if(!strucmp(flagname, "important")) + return(mc->flagged); + + if(!strucmp(flagname, "answered")) + return(mc->answered); + + if(!strucmp(flagname, "recent")) + return(mc->recent); + + return(0); +} + + +/* + * peSetFlag - Set requested flags value to 1 or 0 + * + * Params: abjv[0] == flagname + * objv[1] == newvalue + */ +int +peSetFlag(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *flagname, *flagstr = NULL; + int value; + + if((flagname = Tcl_GetStringFromObj(objv[0], NULL)) + && Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_ERROR){ + if(!strucmp(flagname, "deleted")){ + flagstr = "\\DELETED"; + } + else if(!strucmp(flagname, "new")){ + flagstr = "\\SEEN"; + value = !value; + } + else if(!strucmp(flagname, "important")){ + flagstr = "\\FLAGGED"; + } + else if(!strucmp(flagname, "answered")){ + flagstr = "\\ANSWERED"; + } + else if(!strucmp(flagname, "recent")){ + flagstr = "\\RECENT"; + } + + if(flagstr){ + ps_global->c_client_error[0] = '\0'; + mail_flag(ps_global->mail_stream, + ulong2string(uid), + flagstr, (value ? ST_SET : 0L) | ST_UID); + if(ps_global->c_client_error[0] != '\0'){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "peSetFlag: %.40s", + ps_global->c_client_error); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + } + } + + Tcl_SetResult(interp, value ? "1" : "0", TCL_STATIC); + return(TCL_OK); +} + + +/* + * peMsgSelect - Return 1 or 0 based on whether given UID is selected + * + * Params: argv[0] == selected + */ +int +peMsgSelect(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + int value; + + if(objc == 1 && objv[0]){ + if(Tcl_GetIntFromObj(interp, objv[0], &value) != TCL_ERROR){ + if(value){ + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), + peMessageNumber(uid), MN_SLCT, 1); + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), + peMessageNumber(uid), MN_HIDE, 0); + } else { + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), + peMessageNumber(uid), MN_SLCT, 0); + /* if zoomed, lite hidden bit */ + if(any_lflagged(sp_msgmap(ps_global->mail_stream), MN_HIDE)) + set_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), + peMessageNumber(uid), MN_HIDE, 1); + + } + } + else{ + Tcl_SetResult(interp, "peMsgSelect: can't get value", TCL_STATIC); + return(TCL_ERROR); + } + } + + Tcl_SetResult(interp, + (get_lflag(ps_global->mail_stream, NULL, + peSequenceNumber(uid), + MN_SLCT)) + ? "1" : "0", + TCL_VOLATILE); + return(TCL_OK); +} + + +/* + * peAppendIndexParts - append list of digested index pieces to given object + * + * Params: + * + */ +int +peAppendIndexParts(Tcl_Interp *interp, imapuid_t uid, Tcl_Obj *aObj, int *fetched) +{ + Tcl_Obj *objField, *objElement, *objp; + ICE_S *h; + IFIELD_S *f; + IELEM_S *ie; + + + if((h = build_header_work(ps_global, ps_global->mail_stream, + sp_msgmap(ps_global->mail_stream), peMessageNumber(uid), + gPeITop, gPeICount, fetched)) != NULL){ + for(f = h->ifield; f; f = f->next){ + + if((objField = Tcl_NewListObj(0, NULL)) == NULL) + return(TCL_ERROR); + + for(ie = f->ielem; ie ; ie = ie->next){ + + if((objElement = Tcl_NewListObj(0, NULL)) == NULL) + return(TCL_ERROR); + + if(ie->datalen){ + /* FIRST: DATA */ +#if INTERNAL_INDEX_TRUNCATE + char *ep; + + ep = (char *) fs_get((ie->datalen + 1) * sizeof(char)); + sprintf(ep, "%.*s", ie->wid, ie->data); + + /* and other stuff to pack trunc'd element into a new object */ +#endif + + objp = Tcl_NewStringObj(ie->data, ie->datalen); + } + else + objp = Tcl_NewStringObj("", -1); + + if(Tcl_ListObjAppendElement(interp, objElement, objp) != TCL_OK) + return(TCL_ERROR); + + if(ie->color){ + Tcl_Obj *objColor; + char hexcolor[32]; + + if((objp = Tcl_NewListObj(0, NULL)) == NULL) + return(TCL_ERROR); + + hex_colorstr(hexcolor, ie->color->fg); + objColor = Tcl_NewStringObj(hexcolor, -1); + if(Tcl_ListObjAppendElement(interp, objp, objColor) != TCL_OK) + return(TCL_ERROR); + + hex_colorstr(hexcolor, ie->color->bg); + objColor = Tcl_NewStringObj(hexcolor, -1); + if(Tcl_ListObjAppendElement(interp, objp, objColor) != TCL_OK) + return(TCL_ERROR); + } + else + objp = Tcl_NewStringObj("", -1); + + if(Tcl_ListObjAppendElement(interp, objElement, objp) != TCL_OK) + return(TCL_ERROR); + + /* + * IF we ever want to map the thread characters into nice + * graphical symbols or take advantage of features like clicking + * on a thread element to collapse and such, we need to have + * element tagging. That's what the object creation and append + * are placeholders for + */ + switch(ie->type){ + case eThreadInfo : + objp = Tcl_NewStringObj("threadinfo", -1); + break; + case eText : + objp = NULL; + break; + default : + objp = Tcl_NewStringObj(int2string(ie->type), -1); + break; + } + + if(objp && Tcl_ListObjAppendElement(interp, objElement, objp) != TCL_OK) + return(TCL_ERROR); + + if(Tcl_ListObjAppendElement(interp, objField, objElement) != TCL_OK) + return(TCL_ERROR); + } + + if(Tcl_ListObjAppendElement(interp, aObj, objField) != TCL_OK){ + return(TCL_ERROR); + } + } + } + + return(TCL_OK); +} + + +/* + * peAppendIndexColor - append index line's foreground/background color + * + * Params: + * + */ +int +peAppendIndexColor(Tcl_Interp *interp, imapuid_t uid, Tcl_Obj *aObj, int *fetched) +{ + char hexfg[32], hexbg[32]; + ICE_S *h; + + if((h = build_header_work(ps_global, ps_global->mail_stream, + sp_msgmap(ps_global->mail_stream), peMessageNumber(uid), + gPeITop, gPeICount, fetched)) + && h->color_lookup_done + && h->linecolor){ + + hex_colorstr(hexfg, h->linecolor->fg); + hex_colorstr(hexbg, h->linecolor->bg); + + return(peAppListF(interp, aObj, "%s%s", hexfg, hexbg)); + } + + return(peAppListF(interp, aObj, "%s", "")); +} + + +/* + * peMessageStatusBits - return list flags indicating pine status bits + * + * Params: + * + * Returns: list of lists where: + * * the first element is the list of + * field elements data + * * the second element is a two element + * list containing the lines foreground + * and background colors + */ +int +peMessageStatusBits(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + Tcl_SetResult(interp, + peMsgStatBitString(ps_global, ps_global->mail_stream, + sp_msgmap(ps_global->mail_stream), peMessageNumber(uid), + gPeITop, gPeICount, NULL), + TCL_STATIC); + return(TCL_OK); +} + + +char * +peMsgStatBitString(struct pine *state, + MAILSTREAM *stream, + MSGNO_S *msgmap, + long msgno, + long top_msgno, + long msgcount, + int *fetched) +{ + static char buf[36]; + int i; + long raw; + MESSAGECACHE *mc; + ICE_S *h; + + raw = mn_m2raw(msgmap, msgno); + if((h = build_header_work(state, stream, msgmap, + msgno, top_msgno, msgcount, fetched)) + && (mc = mail_elt(stream, raw))){ + /* return a string representing a bit field where: + index meaning + ----- ------- + 0 "New" + 1 deleted + 2 answered + 3 flagged + 4 to us + 5 cc us + 6 recent + 7 forwarded + 8 attachments + */ + i = 0; + buf[i++] = (mc->seen) ? '0' : '1'; + buf[i++] = (mc->deleted) ? '1' : '0'; + buf[i++] = (mc->answered) ? '1' : '0'; + buf[i++] = (mc->flagged) ? '1' : '0'; + buf[i++] = (h->to_us) ? '1' : '0'; + buf[i++] = (h->cc_us) ? '1' : '0'; + buf[i++] = (mc->recent) ? '1' : '0'; + buf[i++] = (user_flag_is_set(stream, raw, FORWARDED_FLAG)) ? '1' : '0'; + buf[i++] = '0'; + buf[i++] = '\0'; + + return(buf); + } + + return("100000000"); +} + + +Tcl_Obj * +peMsgStatNameList(Tcl_Interp *interp, + struct pine *state, + MAILSTREAM *stream, + MSGNO_S *msgmap, + long msgno, + long top_msgno, + long msgcount, + int *fetched) +{ + Tcl_Obj *objList; + long raw; + MESSAGECACHE *mc; + ICE_S *h; + + objList = Tcl_NewListObj(0, NULL); + raw = mn_m2raw(msgmap, msgno); + if((h = build_header_work(state, stream, msgmap, + msgno, top_msgno, msgcount, fetched)) + && (mc = mail_elt(stream, raw))){ + if(!mc->seen) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("new", -1)); + + if(mc->deleted) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("deleted", -1)); + + if(mc->answered) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("answered", -1)); + + if(mc->flagged) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("flagged", -1)); + + if(h->to_us) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("to_us", -1)); + + if(h->cc_us) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("cc_us", -1)); + + if(mc->recent) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("recent", -1)); + + if(user_flag_is_set(stream, raw, FORWARDED_FLAG)) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("forwarded", -1)); + + if(get_lflag(ps_global->mail_stream, sp_msgmap(ps_global->mail_stream), msgno, MN_SLCT)) + Tcl_ListObjAppendElement(interp, objList, Tcl_NewStringObj("selected", -1)); + } + + return(objList); +} + + +/* + * peReplyHeaders - return subject used in reply to given message + * + * Params: + * + * Returns: list of header value pairs where headers are: + * In-Reply-To:, Subject:, Cc: + * + */ +int +peReplyHeaders(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + long raw; + int flags = RSF_FORCE_REPLY_TO | RSF_FORCE_REPLY_ALL, err = FALSE; + char *errmsg = NULL, *fcc = NULL, *sect = NULL; + ENVELOPE *env, *outgoing; + BODY *body = NULL; + ADDRESS *saved_from, *saved_to, *saved_cc, *saved_resent; + + saved_from = (ADDRESS *) NULL; + saved_to = (ADDRESS *) NULL; + saved_cc = (ADDRESS *) NULL; + saved_resent = (ADDRESS *) NULL; + + raw = peSequenceNumber(uid); + + /* if we're given a valid section number that + * corresponds to a valid msg/rfc822 body part + * then set up headers in attached message. + */ + if(objc == 1 && objv[0] + && (sect = Tcl_GetStringFromObj(objv[0], NULL)) && *sect != '\0' + && (body = mail_body(ps_global->mail_stream, raw, (unsigned char *) sect)) + && body->type == TYPEMESSAGE + && !strucmp(body->subtype, "rfc822")){ + env = body->nested.msg->env; + } + else{ + sect = NULL; + env = mail_fetchstructure(ps_global->mail_stream, raw, NULL); + } + + if(env){ + if(!reply_harvest(ps_global, raw, sect, env, + &saved_from, &saved_to, &saved_cc, + &saved_resent, &flags)){ + + Tcl_SetResult(interp, "", TCL_STATIC); + return(TCL_ERROR); + } + + outgoing = mail_newenvelope(); + + reply_seed(ps_global, outgoing, env, + saved_from, saved_to, saved_cc, saved_resent, + &fcc, flags, &errmsg); + if(errmsg){ + if(*errmsg){ + q_status_message1(SM_ORDER, 3, 3, "%.200s", errmsg); + } + + fs_give((void **)&errmsg); + } + + env = pine_mail_fetchstructure(ps_global->mail_stream, raw, NULL); + + outgoing->subject = reply_subject(env->subject, NULL, 0); + outgoing->in_reply_to = reply_in_reply_to(env); + + err = !(peAppListF(interp, Tcl_GetObjResult(interp), + "%s%a", "to", outgoing->to) == TCL_OK + && peAppListF(interp, Tcl_GetObjResult(interp), + "%s%a", "cc", outgoing->cc) == TCL_OK + && peAppListF(interp, Tcl_GetObjResult(interp), + "%s%s", "in-reply-to", outgoing->in_reply_to) == TCL_OK + && peAppListF(interp, Tcl_GetObjResult(interp), + "%s%s", "subject", + rfc1522_decode_to_utf8((unsigned char *) tmp_20k_buf, + SIZEOF_20KBUF, outgoing->subject)) == TCL_OK + && (fcc ? peFccAppend(interp, Tcl_GetObjResult(interp), fcc, -1) : TRUE)); + + + /* Fill in x-reply-uid data and append it */ + if(!err && ps_global->mail_stream->uid_validity){ + char *prefix = reply_quote_str(env); + + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "(%d %s)(1 %lu %lu)%s", + strlen(prefix), prefix, + ps_global->mail_stream->uid_validity, uid, + ps_global->mail_stream->mailbox); + + fs_give((void **) &prefix); + + err = peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", + "x-reply-uid", tmp_20k_buf) != TCL_OK; + } + + mail_free_envelope(&outgoing); + + if(err) + return(TCL_ERROR); + } + else + Tcl_SetResult(interp, "", TCL_VOLATILE); + + return(TCL_OK); +} + + + +/* + * peReplyText - return subject used in reply to given message + * + * Params: + * + * Returns: + * + */ +int +peReplyText(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + long msgno; + char *prefix, *sect = NULL; + int rv = TCL_OK; + ENVELOPE *env; + BODY *body = NULL, *orig_body; + STORE_S *msgtext; + REDRAFT_POS_S *redraft_pos = NULL; + Tcl_Obj *objBody = NULL, *objAttach = NULL; + + msgno = peSequenceNumber(uid); + + if((msgtext = (void *) so_get(CharStar, NULL, EDIT_ACCESS)) == NULL){ + Tcl_SetResult(interp, "Unable to create storage for reply text", TCL_VOLATILE); + return(TCL_ERROR); + } + + /*--- Grab current envelope ---*/ + /* if we're given a valid section number that + * corresponds to a valid msg/rfc822 body part + * then set up to reply the attached message's + * text. + */ + if(objc == 2 && objv[1] + && (sect = Tcl_GetStringFromObj(objv[1], NULL)) && *sect != '\0' + && (body = mail_body(ps_global->mail_stream, msgno, (unsigned char *) sect)) + && body->type == TYPEMESSAGE + && !strucmp(body->subtype, "rfc822")){ + env = body->nested.msg->env; + orig_body = body->nested.msg->body; + } + else{ + sect = NULL; + env = mail_fetchstructure(ps_global->mail_stream, msgno, &orig_body); + if(!(env && orig_body)){ + Tcl_SetResult(interp, "Unable to fetch message parts", TCL_VOLATILE); + return(TCL_ERROR); + } + } + + if((prefix = Tcl_GetStringFromObj(objv[0], NULL)) != NULL) + prefix = cpystr(prefix); + else + prefix = reply_quote_str(env); + + /* + * BUG? Should there be some way to signal to reply_bddy + * that we'd like it to produced format=flowed body text? + * right now it's hardwired to in pine/reply.c + */ + + if((body = reply_body(ps_global->mail_stream, env, orig_body, + msgno, sect, msgtext, prefix, + TRUE, NULL, TRUE, &redraft_pos)) != NULL){ + + objBody = Tcl_NewListObj(0, NULL); + + peSoStrToList(interp, objBody, msgtext); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objBody); + + /* sniff for attachments */ + objAttach = peMsgAttachCollector(interp, body); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objAttach); + + + pine_free_body(&body); + } + else{ + Tcl_SetResult(interp, "Can't create body text", TCL_VOLATILE); + rv = TCL_ERROR; + } + + fs_give((void **) &prefix); + + return(rv); +} + + +int +peSoStrToList(Tcl_Interp *interp, Tcl_Obj *obj, STORE_S *so) +{ + char *sp, *ep; + Tcl_Obj *objp; + + for(ep = (char *) so_text(so); *ep; ep++){ + sp = ep; + + while(*ep && *ep != '\n') + ep++; + + objp = Tcl_NewStringObj(sp, ep - sp); + + if(Tcl_ListObjAppendElement(interp, obj, objp) != TCL_OK) + return(FALSE); + } + + return(TRUE); +} + + +/* + * peForwardHeaders - return subject used in forward of given message + * + * Params: + * + * Returns: + * + */ +int +peForwardHeaders(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + + int result; + long raw; + char *tmp, *sect = NULL; + ENVELOPE *env; + BODY *body; + + raw = peSequenceNumber(uid); + + /* if we're given a valid section number that + * corresponds to a valid msg/rfc822 body part + * then set up headers in attached message. + */ + if(objc == 1 && objv[0] + && (sect = Tcl_GetStringFromObj(objv[0], NULL)) && *sect != '\0' + && (body = mail_body(ps_global->mail_stream, raw, (unsigned char *) sect)) + && body->type == TYPEMESSAGE + && !strucmp(body->subtype, "rfc822")){ + env = body->nested.msg->env; + } + else{ + sect = NULL; + env = mail_fetchstructure(ps_global->mail_stream, raw, NULL); + } + + if(env){ + tmp = forward_subject(env, FS_NONE); + result = peAppListF(interp, Tcl_GetObjResult(interp), + "%s%s", "subject", tmp); + fs_give((void **) &tmp); + + /* Fill in x-reply-uid data and append it */ + if(result == TCL_OK && ps_global->mail_stream->uid_validity){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "()(1 %lu %lu)%s", + ps_global->mail_stream->uid_validity, uid, + ps_global->mail_stream->mailbox); + result = peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", + "x-reply-uid", tmp_20k_buf) != TCL_OK; + } + + return(result); + } + + Tcl_SetResult(interp, ps_global->last_error, TCL_VOLATILE); + return(TCL_ERROR); +} + + + +/* + * peForwardText - return body of message used in + * forward of given message + * + * Params: + * + * Returns: + * + */ +int +peForwardText(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + long msgno; + char *bodtext, *p, *sect = NULL; + int rv = TCL_OK; + ENVELOPE *env; + BODY *body, *orig_body; + STORE_S *msgtext; + Tcl_Obj *objBody = NULL, *objAttach = NULL; + + msgno = peSequenceNumber(uid); + + if(objc == 1 && objv[0]) + sect = Tcl_GetStringFromObj(objv[0], NULL); + + if((msgtext = (void *) so_get(CharStar, NULL, EDIT_ACCESS)) == NULL){ + Tcl_SetResult(interp, "Unable to create storage for forward text", TCL_VOLATILE); + return(TCL_ERROR); + } + + + if(F_ON(F_FORWARD_AS_ATTACHMENT, ps_global)){ + PART **pp; + long totalsize = 0L; + + /*---- New Body to start with ----*/ + body = mail_newbody(); + body->type = TYPEMULTIPART; + + /*---- The TEXT part/body ----*/ + body->nested.part = mail_newbody_part(); + body->nested.part->body.type = TYPETEXT; + body->nested.part->body.contents.text.data = (unsigned char *) msgtext; + + pp = &(body->nested.part->next); + + /*---- The Message body subparts ----*/ + env = pine_mail_fetchstructure(ps_global->mail_stream, msgno, NULL); + + if(forward_mime_msg(ps_global->mail_stream, msgno, + (sect && *sect != '\0') ? sect : NULL, env, pp, msgtext)){ + totalsize = (*pp)->body.size.bytes; + pp = &((*pp)->next); + } + } + else{ + /*--- Grab current envelope ---*/ + /* if we're given a valid section number that + * corresponds to a valid msg/rfc822 body part + * then set up to forward the attached message's + * text. + */ + + if(sect && *sect != '\0' + && (body = mail_body(ps_global->mail_stream, msgno, (unsigned char *) sect)) + && body->type == TYPEMESSAGE + && !strucmp(body->subtype, "rfc822")){ + env = body->nested.msg->env; + orig_body = body->nested.msg->body; + } + else{ + sect = NULL; + env = mail_fetchstructure(ps_global->mail_stream, msgno, &orig_body); + if(!(env && orig_body)){ + Tcl_SetResult(interp, "Unable to fetch message parts", TCL_VOLATILE); + return(TCL_ERROR); + } + } + + body = forward_body(ps_global->mail_stream, env, orig_body, + msgno, sect, msgtext, FWD_NONE); + } + + if(body){ + bodtext = (char *) so_text(msgtext); + + objBody = Tcl_NewListObj(0, NULL); + + for(p = bodtext; *p; p++){ + Tcl_Obj *objp; + + bodtext = p; + while(*p && *p != '\n') + p++; + + objp = Tcl_NewStringObj(bodtext, p - bodtext); + + Tcl_ListObjAppendElement(interp, objBody, objp); + } + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objBody); + + /* sniff for attachments */ + objAttach = peMsgAttachCollector(interp, body); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objAttach); + + pine_free_body(&body); + } + else{ + Tcl_SetResult(interp, "Can't create body text", TCL_VOLATILE); + rv = TCL_ERROR; + } + + return(rv); +} + + + +/* + * peDetach - + * + * Params: argv[0] == attachment part number + * argv[1] == directory to hold tmp file + * + * Returns: list containing: + * + * 0) response: OK or ERROR + * if OK + * 1) attachment's mime type + * 2) attachment's mime sub-type + * 3) attachment's size in bytes (decoded) + * 4) attachment's given file name (if any) + * 5) tmp file holding raw attachment data + */ +int +peDetach(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *part, *err, *tfd, *tfn = NULL, *filename; + long raw; + gf_io_t pc; + BODY *body; + STORE_S *store; + Tcl_Obj *rvobj, *tObj, *stObj, *fnObj; + + if((part = Tcl_GetStringFromObj(objv[0], NULL)) + && (raw = peSequenceNumber(uid)) + && (body = mail_body(ps_global->mail_stream, raw, (unsigned char *) part))){ + + peGetMimeTyping(body, &tObj, &stObj, &fnObj, NULL); + + err = NULL; + if(!(tfd = Tcl_GetStringFromObj(objv[1], NULL)) || *tfd == '\0'){ + tfn = temp_nam(tfd = NULL, "pd"); + } + else if(is_writable_dir(tfd) == 0){ + tfn = temp_nam(tfd, "pd"); + } + else + tfn = tfd; + + filename = Tcl_GetStringFromObj(fnObj, NULL); + dprint((5, "PEDetach(name: %s, tmpfile: %s)", + filename ? filename : "<null>", tfn)); + + if((store = so_get(FileStar, tfn, WRITE_ACCESS|OWNER_ONLY)) != NULL){ + gf_set_so_writec(&pc, store); + err = detach(ps_global->mail_stream, raw, part, 0L, NULL, pc, NULL, 0); + gf_clear_so_writec(store); + so_give(&store); + } + else + err = "Can't allocate internal storage"; + } + else + err = "Can't get message data"; + + if(err){ + if(tfn) + unlink(tfn); + + dprint((1, "PEDetach FAIL: %d: %s", errno, err)); + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Detach (%d): %s", errno, err); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); + } + + /* package up response */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(1, &tObj)); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(1, &stObj)); + + rvobj = Tcl_NewLongObj(name_file_size(tfn)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(1, &rvobj)); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(1, &fnObj)); + rvobj = Tcl_NewStringObj(tfn, -1); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(1, &rvobj)); + + return(TCL_OK); +} + + +/* + * peAttachInfo - + * + * Params: argv[0] == attachment part number + * + * Returns: list containing: + * + * 0) response: OK or ERROR + * if OK + * 1) attachment's mime type + * 2) attachment's mime sub-type + * 3) attachment's size in bytes (decoded) + * 4) attachment's given file name (if any) + * 5) tmp file holding raw attachment data + */ +int +peAttachInfo(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *part; + long raw; + BODY *body; + PARMLIST_S *plist; + Tcl_Obj *tObj, *stObj, *fnObj; + + if((part = Tcl_GetStringFromObj(objv[0], NULL)) + && (raw = peSequenceNumber(uid)) + && (body = mail_body(ps_global->mail_stream, raw, (unsigned char *) part))){ + + peGetMimeTyping(body, &tObj, &stObj, &fnObj, NULL); + } + else{ + Tcl_SetResult(interp, "Can't get message data", TCL_STATIC); + return(TCL_ERROR); + } + + /* package up response */ + + /* filename */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), fnObj); + + /* type */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), tObj); + + /* subtype */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), stObj); + + /* encoding */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj((body->encoding < ENCMAX) + ? body_encodings[body->encoding] + : "Unknown", -1)); + + /* parameters */ + if((plist = rfc2231_newparmlist(body->parameter)) != NULL){ + Tcl_Obj *lObj = Tcl_NewListObj(0, NULL); + Tcl_Obj *pObj[2]; + + while(rfc2231_list_params(plist)){ + pObj[0] = Tcl_NewStringObj(plist->attrib, -1); + pObj[1] = Tcl_NewStringObj(plist->value, -1); + Tcl_ListObjAppendElement(interp, lObj, + Tcl_NewListObj(2, pObj)); + } + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), lObj); + rfc2231_free_parmlist(&plist); + } + + /* size guesstimate */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(comatose((body->encoding == ENCBASE64) + ? ((body->size.bytes * 3)/4) + : body->size.bytes), -1)); + + return(TCL_OK); +} + + +/* + * peSaveDefault - Default saved file name for the given message + * specified collection/folder + * + * Params: + * + * Returns: name of saved message folder or empty string + * + */ +int +peSaveDefault(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *folder; + CONTEXT_S *cntxt, *cp; + int colid; + long rawno; + ENVELOPE *env; + + if(uid){ + if(!(env = pine_mail_fetchstructure(ps_global->mail_stream, + rawno = peSequenceNumber(uid), + NULL))){ + Tcl_SetResult(interp, ps_global->last_error, TCL_VOLATILE); + return(TCL_ERROR); + } + } + else + env = NULL; + + if(!(folder = save_get_default(ps_global, env, rawno, NULL, &cntxt))){ + Tcl_SetResult(interp, "Message expunged!", TCL_VOLATILE); + return(TCL_ERROR); /* message expunged! */ + } + + for(colid = 0, cp = ps_global->context_list; cp && cp != cntxt ; colid++, cp = cp->next) + ; + + if(!cp) + colid = 0; + + (void) Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewIntObj(colid)); + (void) Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(folder, -1)); + return(TCL_OK); +} + + +/* + * peSaveWork - Save message with given UID in current folder to + * specified collection/folder + * + * Params: argv[0] == destination context number + * argv[1] == testination foldername + * + * + */ +int +peSaveWork(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv, long sflags) +{ + int flgs = 0, i, colid; + char *folder, *err = NULL; + CONTEXT_S *cp; + + if(Tcl_GetIntFromObj(interp, objv[0], &colid) != TCL_ERROR){ + if((folder = Tcl_GetStringFromObj(objv[1], NULL)) != NULL){ + mn_set_cur(sp_msgmap(ps_global->mail_stream), peMessageNumber(uid)); + for(i = 0, cp = ps_global->context_list; cp ; i++, cp = cp->next) + if(i == colid) + break; + + if(cp){ + if(!READONLY_FOLDER(ps_global->mail_stream) + && (sflags & PSW_COPY) != PSW_COPY + && ((sflags & PSW_MOVE) == PSW_MOVE || F_OFF(F_SAVE_WONT_DELETE, ps_global))) + flgs |= SV_DELETE; + + if(colid == 0 && !strucmp(folder, "inbox")) + flgs |= SV_INBOXWOCNTXT; + + if(sflags & (PSW_COPY | PSW_MOVE)) + flgs |= SV_FIX_DELS; + + i = save(ps_global, ps_global->mail_stream, + cp, folder, sp_msgmap(ps_global->mail_stream), flgs); + + if(i == mn_total_cur(sp_msgmap(ps_global->mail_stream))){ + if(mn_total_cur(sp_msgmap(ps_global->mail_stream)) <= 1L){ + if(ps_global->context_list->next + && context_isambig(folder)){ + char *tag = (cp->nickname && strlen(cp->nickname)) ? cp->nickname : (cp->label && strlen(cp->label)) ? cp->label : "Folders"; + snprintf(tmp_20k_buf, SIZEOF_20KBUF, + "Message %s %s to \"%.15s%s\" in <%.15s%s>", + long2string(mn_get_cur(sp_msgmap(ps_global->mail_stream))), + (sflags & PSW_MOVE) ? "moved" : "copied", + folder, + (strlen(folder) > 15) ? "..." : "", + tag, + (strlen(tag) > 15) ? "..." : ""); + } + else + snprintf(tmp_20k_buf, SIZEOF_20KBUF, + "Message %s %s to folder \"%.27s%s\"", + long2string(mn_get_cur(sp_msgmap(ps_global->mail_stream))), + (sflags & PSW_MOVE) ? "moved" : "copied", + folder, + (strlen(folder) > 27) ? "..." : ""); + } + else{ + /* with mn_set_cur above, this *should not* happen */ + Tcl_SetResult(interp, "TOO MANY MESSAGES COPIED", TCL_VOLATILE); + return(TCL_ERROR); + } + + if(sflags == PSW_NONE && (flgs & SV_DELETE)){ + strncat(tmp_20k_buf, " and deleted", SIZEOF_20KBUF-strlen(tmp_20k_buf)-1); + tmp_20k_buf[SIZEOF_20KBUF-1] = '\0'; + } + + q_status_message(SM_ORDER, 0, 3, tmp_20k_buf); + return(TCL_OK); + } + + err = ps_global->last_error; + } + else + err = "open: Unrecognized collection ID"; + } + else + err = "open: Can't read folder"; + } + else + err = "open: Can't get collection ID"; + + Tcl_SetResult(interp, err, TCL_VOLATILE); + return(TCL_ERROR); +} + +/* + * peSave - Save message with given UID in current folder to + * specified collection/folder + * + * Params: argv[0] == destination context number + * argv[1] == testination foldername + * + * NOTE: just a wrapper around peSaveWork + */ +int +peSave(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + return(peSaveWork(interp, uid, objc, objv, PSW_NONE)); +} + + +/* + * peCopy - Copy message with given UID in current folder to + * specified collection/folder + * + * Params: argv[0] == destination context number + * argv[1] == testination foldername + * + * NOTE: just a wrapper around peSaveWork that makes sure + * delete-on-save is NOT set + */ +int +peCopy(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + return(peSaveWork(interp, uid, objc, objv, PSW_COPY)); +} + + +/* + * peMove - Move message with given UID in current folder to + * specified collection/folder + * + * Params: argv[0] == destination context number + * argv[1] == testination foldername + * + * NOTE: just a wrapper around peSaveWork that makes sure + * delete-on-save IS set so it can be expunged + */ +int +peMove(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + return(peSaveWork(interp, uid, objc, objv, PSW_MOVE)); +} + + +/* + * peGotoDefault - Default Goto command file name for the given message + * specified collection/folder + * + * Params: + * + * Returns: name of Goto command default folder or empty string + * + */ +int +peGotoDefault(Tcl_Interp *interp, imapuid_t uid, Tcl_Obj **objv) +{ + char *folder = NULL; + CONTEXT_S *cntxt, *cp; + int colid, inbox; + + cntxt = broach_get_folder(ps_global->context_current, &inbox, &folder); + + for(colid = 0, cp = ps_global->context_list; cp != cntxt ; colid++, cp = cp->next) + ; + + if(!cp) + colid = 0; + + (void) Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewIntObj(colid)); + (void) Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(folder ? folder : "", -1)); + return(TCL_OK); +} + + +/* + * peReplyQuote - + * + * Params: argv[0] == attachment part number + * + * Returns: list containing: + * + */ +int +peReplyQuote(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *quote; + ENVELOPE *env; + + if(uid){ + if((env = pine_mail_fetchstructure(ps_global->mail_stream, peSequenceNumber(uid), NULL)) != NULL){ + quote = reply_quote_str(env); + Tcl_SetResult(interp, quote, TCL_VOLATILE); + fs_give((void **) "e); + } + else{ + Tcl_SetResult(interp, ps_global->last_error, TCL_VOLATILE); + return(TCL_ERROR); + } + } + else + Tcl_SetResult(interp, "> ", TCL_VOLATILE); + + return(TCL_OK); +} + + +void +peGetMimeTyping(BODY *body, Tcl_Obj **tObjp, Tcl_Obj **stObjp, Tcl_Obj **fnObjp, Tcl_Obj **extObjp) +{ + char *ptype = NULL, *psubtype = NULL, *pfile = NULL; + + /*------- Figure out suggested file name ----*/ + if(body){ + if((pfile = get_filename_parameter(NULL, 0, body, NULL)) != NULL){ + /* + * if part is generic, see if we can get anything + * more from the suggested filename's extension... + */ + if(body->type == TYPEAPPLICATION + && (!body->subtype + || !strucmp(body->subtype, "octet-stream"))){ + BODY *fakebody = mail_newbody(); + + if(set_mime_type_by_extension(fakebody, pfile)){ + ptype = body_type_names(fakebody->type); + psubtype = cpystr(fakebody->subtype); + } + + mail_free_body(&fakebody); + } + } + + if(!ptype) { + ptype = body_type_names(body->type); + psubtype = cpystr(body->subtype + ? body->subtype + : (body->type == TYPETEXT) + ? "plain" + : (body->type == TYPEAPPLICATION) + ? "octet-stream" + : ""); + } + } + else{ + ptype = body_type_names(TYPETEXT); + psubtype = cpystr("plain"); + } + + if(extObjp){ + *extObjp = Tcl_NewStringObj("", 0); + + if(ptype && psubtype && pfile){ + size_t l; + char *mtype; + char extbuf[32]; /* mailcap.c limits to three */ + + l = strlen(ptype) + strlen(psubtype) + 1; + mtype = (char *) fs_get((l+1) * sizeof(char)); + + snprintf(mtype, l+1, "%s/%s", ptype, psubtype); + + if(!set_mime_extension_by_type(extbuf, mtype)){ + char *dotp, *p; + + for(dotp = NULL, p = pfile; *p; p++) + if(*p == '.') + dotp = p + 1; + + if(dotp) + Tcl_SetStringObj(*extObjp, dotp, -1); + } + else + Tcl_SetStringObj(*extObjp, extbuf, -1); + + fs_give((void **) &mtype); + } + } + + if(tObjp) + *tObjp = Tcl_NewStringObj(ptype, -1); + + if(psubtype){ + if(stObjp) + *stObjp = Tcl_NewStringObj(psubtype, -1); + + fs_give((void **) &psubtype); + } + else if(stObjp) + *stObjp = Tcl_NewStringObj("", 0); + + if(pfile){ + if(fnObjp) + *fnObjp = Tcl_NewStringObj(pfile, -1); + + fs_give((void **) &pfile); + } + else if(fnObjp) + *fnObjp = Tcl_NewStringObj("", 0); +} + + +/* + * peAppListF - generate a list of elements based on fmt string, + * then append it to the given list object + * + */ +int +peAppListF(Tcl_Interp *interp, Tcl_Obj *lobjp, char *fmt, ...) +{ + va_list args; + char *p, *sval, nbuf[128]; + int ival, err = 0; + unsigned int uval; + long lval; + unsigned long luval; + PATTERN_S *pval; + ADDRESS *aval; + INTVL_S *vval; + Tcl_Obj *lObj = NULL, *sObj; + + if((lObj = Tcl_NewListObj(0, NULL)) != NULL){ + va_start(args, fmt); + for(p = fmt; *p && !err; p++){ + sObj = NULL; + + if(*p == '%') + switch(*++p){ + case 'i' : /* int value */ + ival = va_arg(args, int); + if((sObj = Tcl_NewIntObj(ival)) == NULL) + err++; + + break; + + case 'u' : /* unsigned int value */ + uval = va_arg(args, unsigned int); + snprintf(nbuf, sizeof(nbuf), "%u", uval); + if((sObj = Tcl_NewStringObj(nbuf, -1)) == NULL) + err++; + + break; + + case 'l' : /* long value */ + if(*(p+1) == 'u'){ + p++; + luval = va_arg(args, unsigned long); + snprintf(nbuf, sizeof(nbuf), "%lu", luval); + if((sObj = Tcl_NewStringObj(nbuf, -1)) == NULL) + err++; + } + else{ + lval = va_arg(args, long); + if((sObj = Tcl_NewLongObj(lval)) == NULL) + err++; + } + + break; + + case 's' : /* string value */ + sval = va_arg(args, char *); + sObj = Tcl_NewStringObj(sval ? sval : "", -1); + if(sObj == NULL) + err++; + + break; + + case 'a': /* ADDRESS list */ + aval = va_arg(args, ADDRESS *); + if(aval){ + char *tmp, *p; + RFC822BUFFER rbuf; + size_t len; + + len = est_size(aval); + tmp = (char *) fs_get(len * sizeof(char)); + tmp[0] = '\0'; + rbuf.f = dummy_soutr; + rbuf.s = NULL; + rbuf.beg = tmp; + rbuf.cur = tmp; + rbuf.end = tmp+len-1; + rfc822_output_address_list(&rbuf, aval, 0L, NULL); + *rbuf.cur = '\0'; + p = (char *) rfc1522_decode_to_utf8((unsigned char *) tmp_20k_buf, SIZEOF_20KBUF, tmp); + sObj = Tcl_NewStringObj(p, strlen(p)); + fs_give((void **) &tmp); + } + else + sObj = Tcl_NewStringObj("", -1); + + break; + + case 'p': /* PATTERN_S * */ + pval = va_arg(args, PATTERN_S *); + sval = pattern_to_string(pval); + sObj = Tcl_NewStringObj(sval ? sval : "", -1); + break; + + case 'v': /* INTVL_S * */ + vval = va_arg(args, INTVL_S *); + if(vval){ + for(; vval != NULL; vval = vval->next){ + peAppListF(interp, sObj, "%l%l", vval->imin, vval->imax); + } + } + else + sObj = Tcl_NewListObj(0, NULL); + + break; + + case 'o': /* Tcl_Obj * */ + sObj = va_arg(args, Tcl_Obj *); + break; + } + + if(sObj) + Tcl_ListObjAppendElement(interp, lObj, sObj); + } + + va_end(args); + } + + return(lObj ? Tcl_ListObjAppendElement(interp, lobjp, lObj) : TCL_ERROR); +} + +/* + * pePatAppendID - append list of pattern identity variables to given object + */ +void +pePatAppendID(Tcl_Interp *interp, Tcl_Obj *patObj, PAT_S *pat) +{ + Tcl_Obj *resObj; + + resObj = Tcl_NewListObj(0, NULL); + peAppListF(interp, resObj, "%s%s", "nickname", pat->patgrp->nick); + peAppListF(interp, resObj, "%s%s", "comment", pat->patgrp->comment); + Tcl_ListObjAppendElement(interp, patObj, resObj); +} + + +/* + * pePatAppendPattern - append list of pattern variables to given object + */ +void +pePatAppendPattern(Tcl_Interp *interp, Tcl_Obj *patObj, PAT_S *pat) +{ + ARBHDR_S *ah; + Tcl_Obj *resObj; + + resObj = Tcl_NewListObj(0, NULL); + peAppListF(interp, resObj, "%s%p", "to", pat->patgrp->to); + peAppListF(interp, resObj, "%s%p", "from", pat->patgrp->from); + peAppListF(interp, resObj, "%s%p", "sender", pat->patgrp->sender); + peAppListF(interp, resObj, "%s%p", "cc", pat->patgrp->cc); + peAppListF(interp, resObj, "%s%p", "recip", pat->patgrp->recip); + peAppListF(interp, resObj, "%s%p", "partic", pat->patgrp->partic); + peAppListF(interp, resObj, "%s%p", "news", pat->patgrp->news); + peAppListF(interp, resObj, "%s%p", "subj", pat->patgrp->subj); + peAppListF(interp, resObj, "%s%p", "alltext", pat->patgrp->alltext); + peAppListF(interp, resObj, "%s%p", "bodytext", pat->patgrp->bodytext); + peAppListF(interp, resObj, "%s%p", "keyword", pat->patgrp->keyword); + peAppListF(interp, resObj, "%s%p", "charset", pat->patgrp->charsets); + + peAppListF(interp, resObj, "%s%v", "score", pat->patgrp->score); + peAppListF(interp, resObj, "%s%v", "age", pat->patgrp->age); + peAppListF(interp, resObj, "%s%v", "size", pat->patgrp->size); + + if((ah = pat->patgrp->arbhdr) != NULL){ + Tcl_Obj *hlObj, *hObj; + + hlObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, hlObj, Tcl_NewStringObj("headers", -1)); + + for(; ah; ah = ah->next){ + hObj = Tcl_NewListObj(0, NULL); + peAppListF(interp, hObj, "%s%p", ah->field ? ah->field : "", ah->p); + Tcl_ListObjAppendElement(interp, hlObj, hObj); + } + + Tcl_ListObjAppendElement(interp, resObj, hlObj); + } + + switch(pat->patgrp->fldr_type){ + case FLDR_ANY: + peAppListF(interp, resObj, "%s%s", "ftype", "any"); + break; + case FLDR_NEWS: + peAppListF(interp, resObj, "%s%s", "ftype", "news"); + break; + case FLDR_EMAIL: + peAppListF(interp, resObj, "%s%s", "ftype", "email"); + break; + case FLDR_SPECIFIC: + peAppListF(interp, resObj, "%s%s", "ftype", "specific"); + break; + } + + peAppListF(interp, resObj, "%s%p", "folder", pat->patgrp->folder); + peAppListF(interp, resObj, "%s%s", "stat_new", pePatStatStr(pat->patgrp->stat_new)); + peAppListF(interp, resObj, "%s%s", "stat_rec", pePatStatStr(pat->patgrp->stat_rec)); + peAppListF(interp, resObj, "%s%s", "stat_del", pePatStatStr(pat->patgrp->stat_del)); + peAppListF(interp, resObj, "%s%s", "stat_imp", pePatStatStr(pat->patgrp->stat_imp)); + peAppListF(interp, resObj, "%s%s", "stat_ans", pePatStatStr(pat->patgrp->stat_ans)); + peAppListF(interp, resObj, "%s%s", "stat_8bitsubj", pePatStatStr(pat->patgrp->stat_8bitsubj)); + peAppListF(interp, resObj, "%s%s", "stat_bom", pePatStatStr(pat->patgrp->stat_bom)); + peAppListF(interp, resObj, "%s%s", "stat_boy", pePatStatStr(pat->patgrp->stat_boy)); + + Tcl_ListObjAppendElement(interp, patObj, resObj); +} + + +char * +pePatStatStr(int value) +{ + switch(value){ + case PAT_STAT_EITHER: + return("either"); + break; + + case PAT_STAT_YES: + return("yes"); + break; + + default : + return("no"); + break; + } +} + + +/* + * peCreateUserContext - create new ps_global and set it up + */ +char * +peCreateUserContext(Tcl_Interp *interp, char *user, char *config, char *defconf) +{ + if(ps_global) + peDestroyUserContext(&ps_global); + + set_collation(1, 1); + + ps_global = new_pine_struct(); + + /*---------------------------------------------------------------------- + Place any necessary constraints on pith processing + ----------------------------------------------------------------------*/ + + /* got thru close procedure without expunging */ + ps_global->noexpunge_on_close = 1; + + /* do NOT let user set path to local executable */ + ps_global->vars[V_SENDMAIL_PATH].is_user = 0; + + + /*---------------------------------------------------------------------- + Proceed with reading acquiring user settings + ----------------------------------------------------------------------*/ + if(ps_global->pinerc) + fs_give((void **) &ps_global->pinerc); + + if(ps_global->prc) + free_pinerc_s(&ps_global->prc); + + if(!IS_REMOTE(config)){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Non-Remote config: %s", config); + return(tmp_20k_buf); + } + + ps_global->prc = new_pinerc_s(config); + + if(defconf){ + if(ps_global->pconf) + free_pinerc_s(&ps_global->pconf); + + ps_global->pconf = new_pinerc_s(defconf); + } + + /* + * Fake up some user information + */ + ps_global->ui.login = cpystr(user); + +#ifdef DEBUG + /* + * Prep for IMAP debugging + */ + setup_imap_debug(); +#endif + + /* CHECK FOR AND PASS BACK ANY INIT ERRORS */ + return(peLoadConfig(ps_global)); +} + + + +void +peDestroyUserContext(struct pine **pps) +{ + + completely_done_with_adrbks(); + + free_pinerc_strings(pps); +#if 0 + imap_flush_passwd_cache(TRUE); +#endif + clear_index_cache(sp_inbox_stream(), 0); + free_newsgrp_cache(); + mailcap_free(); + close_patterns(0L); + free_extra_hdrs(); + free_contexts(&ps_global->context_list); + + pico_endcolor(); + + free_strlist(&peCertHosts); + + free_pine_struct(pps); +} + + +char * +peLoadConfig(struct pine *pine_state) +{ + int rv; + char *s, *db = NULL; + extern void init_signals(void); /* in signal.c */ + + if(!pine_state) + return("No global state present"); + +#if 0 +/*turned off because we don't care about local user*/ + /* need home directory early */ + get_user_info(&pine_state->ui); + + pine_state->home_dir = cpystr((getenv("HOME") != NULL) + ? getenv("HOME") + : pine_state->ui.homedir); +#endif + + init_pinerc(pine_state, &db); + + fs_give((void **) &db); + + /* + * Initial allocation of array of stream pool pointers. + * We do this before init_vars so that we can re-use streams used for + * remote config files. These sizes may get changed later. + */ + ps_global->s_pool.max_remstream = 2; + + ps_global->c_client_error[0] = '\0'; + + pePrepareForAuthException(); + + peInitVars(pine_state); + + if(s = peAuthException()) + return(s); + else if(ps_global->c_client_error[0]) + return(ps_global->c_client_error); + + mail_parameters(NULL, SET_SENDCOMMAND, (void *) pine_imap_cmd_happened); + mail_parameters(NULL, SET_FREESTREAMSPAREP, (void *) sp_free_callback); + mail_parameters(NULL, SET_FREEELTSPAREP, (void *) free_pine_elt); + + /* + * Install callback to handle certificate validation failures, + * allowing the user to continue if they wish. + */ + mail_parameters(NULL, SET_SSLCERTIFICATEQUERY, (void *) alpine_sslcertquery); + mail_parameters(NULL, SET_SSLFAILURE, (void *) alpine_sslfailure); + + /* + * Set up a c-client read timeout and timeout handler. In general, + * it shouldn't happen, but a server crash or dead link can cause + * pine to appear wedged if we don't set this up... + */ + mail_parameters(NULL, SET_OPENTIMEOUT, + (void *)((pine_state->VAR_TCPOPENTIMEO + && (rv = atoi(pine_state->VAR_TCPOPENTIMEO)) > 4) + ? (long) rv : 30L)); + mail_parameters(NULL, SET_TIMEOUT, (void *) alpine_tcptimeout); + + if(pine_state->VAR_RSHOPENTIMEO + && ((rv = atoi(pine_state->VAR_RSHOPENTIMEO)) == 0 || rv > 4)) + mail_parameters(NULL, SET_RSHTIMEOUT, (void *) rv); + + if(pine_state->VAR_SSHOPENTIMEO + && ((rv = atoi(pine_state->VAR_SSHOPENTIMEO)) == 0 || rv > 4)) + mail_parameters(NULL, SET_SSHTIMEOUT, (void *) rv); + + /* + * Tell c-client not to be so aggressive about uid mappings + */ + mail_parameters(NULL, SET_UIDLOOKAHEAD, (void *) 20); + + /* + * Setup referral handling + */ + mail_parameters(NULL, SET_IMAPREFERRAL, (void *) imap_referral); + mail_parameters(NULL, SET_MAILPROXYCOPY, (void *) imap_proxycopy); + + /* + * Install extra headers to fetch along with all the other stuff + * mail_fetch_structure and mail_fetch_overview requests. + */ + calc_extra_hdrs(); + + if(get_extra_hdrs()) + (void) mail_parameters(NULL, SET_IMAPEXTRAHEADERS, (void *) get_extra_hdrs()); + + (void) init_username(pine_state); + + (void) init_hostname(ps_global); + +#ifdef ENABLE_LDAP + (void) init_ldap_pname(ps_global); +#endif /* ENABLE_LDAP */ + + if(ps_global->prc && ps_global->prc->type == Loc && + can_access(ps_global->pinerc, ACCESS_EXISTS) == 0 && + can_access(ps_global->pinerc, EDIT_ACCESS) != 0) + ps_global->readonly_pinerc = 1; + + /* + * c-client needs USR2 and we might as well + * do something sensible with HUP and TERM + */ + init_signals(); + + strncpy(pine_state->inbox_name, INBOX_NAME, sizeof(pine_state->inbox_name)); + pine_state->inbox_name[sizeof(pine_state->inbox_name)-1] = '\0'; + + init_folders(pine_state); /* digest folder spec's */ + + /* + * Various options we want to make sure are set OUR way + */ + F_TURN_ON(F_QUELL_IMAP_ENV_CB, pine_state); + F_TURN_ON(F_SLCTBL_ITEM_NOBOLD, pine_state); + F_TURN_OFF(F_USE_SYSTEM_TRANS, pine_state); + + /* + * Fake screen dimensions for index formatting and + * message display wrap... + */ + ps_global->ttyo = (struct ttyo *) fs_get(sizeof(struct ttyo)); + ps_global->ttyo->screen_rows = FAKE_SCREEN_LENGTH; + ps_global->ttyo->screen_cols = FAKE_SCREEN_WIDTH; + if(ps_global->VAR_WP_COLUMNS){ + int w = atoi(ps_global->VAR_WP_COLUMNS); + if(w >= 20 && w <= 128) + ps_global->ttyo->screen_cols = w; + } + + ps_global->ttyo->header_rows = 0; + ps_global->ttyo->footer_rows = 0; + + + /* init colors */ + if(ps_global->VAR_NORM_FORE_COLOR) + pico_nfcolor(ps_global->VAR_NORM_FORE_COLOR); + + if(ps_global->VAR_NORM_BACK_COLOR) + pico_nbcolor(ps_global->VAR_NORM_BACK_COLOR); + + if(ps_global->VAR_REV_FORE_COLOR) + pico_rfcolor(ps_global->VAR_REV_FORE_COLOR); + + if(ps_global->VAR_REV_BACK_COLOR) + pico_rbcolor(ps_global->VAR_REV_BACK_COLOR); + + pico_set_normal_color(); + + return(NULL); +} + + +int +peCreateStream(Tcl_Interp *interp, CONTEXT_S *context, char *mailbox, int do_inbox) +{ + unsigned long flgs = 0L; + char *s; + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + + pePrepareForAuthException(); + + if(do_inbox) + flgs |= DB_INBOXWOCNTXT; + + if(do_broach_folder(mailbox, context, NULL, flgs) && ps_global->mail_stream){ + dprint((SYSDBG_INFO, "Mailbox open: %s", + ps_global->mail_stream->mailbox ? ps_global->mail_stream->mailbox : "<UNKNOWN>")); + return(TCL_OK); + } + + Tcl_SetResult(interp, + (s = peAuthException()) + ? s + : (*ps_global->last_error) + ? ps_global->last_error + : "Login Error", + TCL_VOLATILE); + return(TCL_ERROR); +} + + +void +peDestroyStream(struct pine *ps) +{ + int cur_is_inbox; + + if(ps){ + cur_is_inbox = (sp_inbox_stream() == ps_global->mail_stream); + + /* clean up open streams */ + if(ps->mail_stream){ + expunge_and_close(ps->mail_stream, NULL, EC_NONE); + ps_global->mail_stream = NULL; + ps_global->cur_folder[0] = '\0'; + } + + if(ps->msgmap) + mn_give(&ps->msgmap); + + if(sp_inbox_stream() && !cur_is_inbox){ + ps->mail_stream = sp_inbox_stream(); + ps->msgmap = sp_msgmap(ps->mail_stream); + sp_set_expunge_count(ps_global->mail_stream, 0L); + expunge_and_close(sp_inbox_stream(), NULL, EC_NONE); + mn_give(&ps->msgmap); + } + } +} + + +/* + * pePrepareForAuthException - set globals to get feedback from bowels of c-client + */ +void +pePrepareForAuthException(void) +{ + peNoPassword = peCredentialError = peCertFailure = peCertQuery = 0; +} + +/* + * pePrepareForAuthException - check globals getting feedback from bowels of c-client + */ +char * +peAuthException() +{ + static char buf[CRED_REQ_SIZE]; + + if(peCertQuery){ + snprintf(buf, CRED_REQ_SIZE, "%s %s", CERT_QUERY_STRING, peCredentialRequestor); + return(buf); + } + + if(peCertFailure){ + snprintf(buf, CRED_REQ_SIZE, "%s %s", CERT_FAILURE_STRING, peCredentialRequestor); + return(buf); + } + + if(peNoPassword){ + snprintf(buf, CRED_REQ_SIZE, "%s %s", AUTH_EMPTY_STRING, peCredentialRequestor); + return(buf); + } + + if(peCredentialError){ + snprintf(buf, CRED_REQ_SIZE, "%s %s", AUTH_FAILURE_STRING, peCredentialRequestor); + return(buf); + } + + return(NULL); +} + + +void +peInitVars(struct pine *ps) +{ + init_vars(ps, NULL); + + /* + * fix display/keyboard-character-set to utf-8 + * + * + */ + + if(ps->display_charmap) + fs_give((void **) &ps->display_charmap); + + ps->display_charmap = cpystr(WP_INTERNAL_CHARSET); + + if(ps->keyboard_charmap) + fs_give((void **) &ps->keyboard_charmap); + + ps->keyboard_charmap = cpystr(WP_INTERNAL_CHARSET); + + (void) setup_for_input_output(FALSE, &ps->display_charmap, &ps->keyboard_charmap, &ps->input_cs, NULL);; +} + + + +int +peMessageBounce(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *errstr = NULL, *to, *subj = NULL, errbuf[WP_MAX_POST_ERROR + 1]; + long rawno; + ENVELOPE *env, *outgoing = NULL; + METAENV *metaenv; + PINEFIELD *custom; + BODY *body = NULL; + + if(uid){ + rawno = peSequenceNumber(uid); + + if(objc > 0 && objv[0] && (to = Tcl_GetStringFromObj(objv[0], NULL))){ + if(objc == 2 && objv[1]){ + subj = Tcl_GetStringFromObj(objv[1], NULL); + } + else if((env = mail_fetchstructure(ps_global->mail_stream, rawno, NULL)) != NULL){ + subj = env->subject; + } + else{ + Tcl_SetResult(interp, ps_global->last_error, TCL_VOLATILE); + return(TCL_ERROR); + } + + if((errstr = bounce_msg_body(ps_global->mail_stream, rawno, NULL, + &to, subj, &outgoing, &body, NULL))){ + Tcl_SetResult(interp, errstr, TCL_VOLATILE); + return(TCL_ERROR); + } + + metaenv = pine_new_env(outgoing, NULL, NULL, custom = peCustomHdrs()); + + if(!outgoing->from) + outgoing->from = generate_from(); + + rfc822_date(tmp_20k_buf); + outgoing->date = (unsigned char *) cpystr(tmp_20k_buf); + + outgoing->return_path = rfc822_cpy_adr(outgoing->from); + if(!outgoing->message_id) + outgoing->message_id = generate_message_id(); + + /* NO FCC */ + + if(peDoPost(metaenv, body, NULL, NULL, errbuf) != TCL_OK) + errstr = errbuf; + + pine_free_body(&body); + + pine_free_env(&metaenv); + + if(custom) + free_customs(custom); + + mail_free_envelope(&outgoing); + pine_free_body(&body); + + } + } + + Tcl_SetResult(interp, (errstr) ? errstr : "OK", TCL_VOLATILE); + return(errstr ? TCL_ERROR : TCL_OK); +} + + +int +peMessageSpamNotice(interp, uid, objc, objv) + Tcl_Interp *interp; + imapuid_t uid; + int objc; + Tcl_Obj **objv; +{ + char *to, *subj = NULL, errbuf[WP_MAX_POST_ERROR + 1], *rs = NULL; + long rawno; + + if(uid){ + rawno = peSequenceNumber(uid); + + if(objv[0] && (to = Tcl_GetStringFromObj(objv[0], NULL)) && strlen(to)){ + + if(objv[1]) + subj = Tcl_GetStringFromObj(objv[1], NULL); + + rs = peSendSpamReport(rawno, to, subj, errbuf); + } + } + + Tcl_SetResult(interp, (rs) ? rs : "OK", TCL_VOLATILE); + return(rs ? TCL_ERROR : TCL_OK); +} + + +char * +peSendSpamReport(long rawno, char *to, char *subj, char *errbuf) +{ + char *errstr = NULL, *tmp_a_string; + ENVELOPE *env, *outgoing; + METAENV *metaenv; + PINEFIELD *custom; + BODY *body; + static char *fakedomain = "@"; + void *msgtext; + + + if((env = mail_fetchstructure(ps_global->mail_stream, rawno, NULL)) == NULL){ + return(ps_global->last_error); + } + + /* empty subject gets "spam" subject */ + if(!(subj && *subj)) + subj = env->subject; + + /*---- New Body to start with ----*/ + body = mail_newbody(); + body->type = TYPEMULTIPART; + + /*---- The TEXT part/body ----*/ + body->nested.part = mail_newbody_part(); + body->nested.part->body.type = TYPETEXT; + + if((msgtext = (void *)so_get(CharStar, NULL, EDIT_ACCESS)) == NULL){ + pine_free_body(&body); + return("peSendSpamReport: Can't allocate text"); + } + else{ + sprintf(tmp_20k_buf, + "The attached message is being reported to <%s> as Spam\n", + to); + so_puts((STORE_S *) msgtext, tmp_20k_buf); + body->nested.part->body.contents.text.data = msgtext; + } + + /*---- Attach the raw message ----*/ + if(forward_mime_msg(ps_global->mail_stream, rawno, NULL, env, + &(body->nested.part->next), msgtext)){ + outgoing = mail_newenvelope(); + metaenv = pine_new_env(outgoing, NULL, NULL, custom = peCustomHdrs()); + } + else{ + pine_free_body(&body); + return("peSendSpamReport: Can't generate forwarded message"); + } + + /* rfc822_parse_adrlist feels free to destroy input so copy */ + tmp_a_string = cpystr(to); + rfc822_parse_adrlist(&outgoing->to, tmp_a_string, + (F_ON(F_COMPOSE_REJECTS_UNQUAL, ps_global)) + ? fakedomain : ps_global->maildomain); + fs_give((void **) &tmp_a_string); + + outgoing->from = generate_from(); + outgoing->subject = cpystr(subj); + outgoing->return_path = rfc822_cpy_adr(outgoing->from); + outgoing->message_id = generate_message_id(); + + rfc822_date(tmp_20k_buf); + outgoing->date = (unsigned char *) cpystr(tmp_20k_buf); + + /* NO FCC for Spam Reporting */ + + if(peDoPost(metaenv, body, NULL, NULL, errbuf) != TCL_OK) + errstr = errbuf; + + pine_free_body(&body); + + pine_free_env(&metaenv); + + if(custom) + free_customs(custom); + + mail_free_envelope(&outgoing); + pine_free_body(&body); + + return(errstr); +} + + +/* * * * * * * * * * * * * Start of Composer Routines * * * * * * * * * * * */ + + +/* + * PEComposeCmd - export various bits of alpine state + */ +int +PEComposeCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *err = "PECompose: Unknown request"; + + dprint((2, "PEComposeCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + } + else if(!ps_global){ + Tcl_SetResult(interp, "peCompose: no config present", TCL_STATIC); + return(TCL_ERROR); + } + else{ + char *s1 = Tcl_GetStringFromObj(objv[1], NULL); + + if(s1){ + if(!strcmp(s1, "post")){ + long flags = PMC_NONE; + if(F_ON(F_COMPOSE_REJECTS_UNQUAL, ps_global)) + flags |= PMC_FORCE_QUAL; + + return(peMsgCollector(interp, objc - 2, (Tcl_Obj **) &objv[2], peDoPost, flags)); + } + else if(objc == 2){ + if(!strcmp(s1, "userhdrs")){ + int i; + char *p; + PINEFIELD *custom, *cp; + ADDRESS *from; + static char *standard[] = {"To", "Cc", "Bcc", "Fcc", "Attach", "Subject", NULL}; + + custom = peCustomHdrs(); + + for(i = 0; standard[i]; i++){ + p = NULL; + for(cp = custom; cp; cp = cp->next) + if(!strucmp(cp->name, standard[i])) + p = cp->textbuf; + + peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", standard[i], p); + } + + for(cp = custom; cp != NULL; cp = cp->next){ + if(!strucmp(cp->name, "from")){ + if(F_OFF(F_ALLOW_CHANGING_FROM, ps_global)) + continue; + + if(cp->textbuf && strlen(cp->textbuf)){ + p = cp->textbuf; + } + else{ + RFC822BUFFER rbuf; + + tmp_20k_buf[0] = '\0'; + rbuf.f = dummy_soutr; + rbuf.s = NULL; + rbuf.beg = tmp_20k_buf; + rbuf.cur = tmp_20k_buf; + rbuf.end = tmp_20k_buf+SIZEOF_20KBUF-1; + rfc822_output_address_list(&rbuf, from = generate_from(), 0L, NULL); + *rbuf.cur = '\0'; + mail_free_address(&from); + p = tmp_20k_buf; + } + } + else{ + p = cp->textbuf; + for(i = 0; standard[i]; i++) + if(!strucmp(standard[i], cp->name)) + p = NULL; + + if(!p) + continue; + } + + peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", cp->name, p); + } + + if(custom) + free_customs(custom); + + return(TCL_OK); + } + else if(!strcmp(s1, "syshdrs")){ + int i; + static char *extras[] = {"In-Reply-To", "X-Reply-UID", NULL}; + + for(i = 0; extras[i]; i++) + peAppListF(interp, Tcl_GetObjResult(interp), "%s%s", extras[i], NULL); + + return(TCL_OK); + } + else if(!strcmp(s1, "composehdrs")){ + char **p, *q; + + if((p = ps_global->VAR_COMP_HDRS) && *p){ + for(; *p; p++) + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(*p, (q = strchr(*p, ':')) + ? (q - *p) : -1)); + } + else + Tcl_SetResult(interp, "", TCL_STATIC); + + return(TCL_OK); + } + else if(!strcmp(s1, "fccdefault")){ + int ci = 0; + CONTEXT_S *c = default_save_context(ps_global->context_list), *c2; + + for(c2 = ps_global->context_list; c && c != c2; c2 = c2->next) + ci++; + + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewIntObj(ci)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ps_global->VAR_DEFAULT_FCC + ? ps_global->VAR_DEFAULT_FCC + : "", -1)); + return(TCL_OK); + } + else if(!strcmp(s1, "noattach")){ + peFreeAttach(&peCompAttach); + Tcl_SetResult(interp, "OK", TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "from")){ + RFC822BUFFER rbuf; + ADDRESS *from = generate_from(); + tmp_20k_buf[0] = '\0'; + rbuf.f = dummy_soutr; + rbuf.s = NULL; + rbuf.beg = tmp_20k_buf; + rbuf.cur = tmp_20k_buf; + rbuf.end = tmp_20k_buf+SIZEOF_20KBUF-1; + rfc822_output_address_list(&rbuf, from, 0L, NULL); + *rbuf.cur = '\0'; + mail_free_address(&from); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_OK); + } + else if(!strcmp(s1, "attachments")){ + COMPATT_S *p; + Tcl_Obj *objAttach; + + for(p = peCompAttach; p; p = p->next) + if(p->file){ + objAttach = Tcl_NewListObj(0, NULL); + + /* id */ + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewStringObj(p->id,-1)); + + /* file name */ + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewStringObj(p->l.f.remote,-1)); + + /* file size */ + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewLongObj(p->l.f.size)); + + /* type/subtype */ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%s/%s", p->l.f.type, p->l.f.subtype); + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewStringObj(tmp_20k_buf,-1)); + + /* append to list */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objAttach); + } + else if(p->body){ + char *name; + + objAttach = Tcl_NewListObj(0, NULL); + + /* id */ + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewStringObj(p->id,-1)); + + /* file name */ + if((name = get_filename_parameter(NULL, 0, p->l.b.body, NULL)) != NULL){ + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewStringObj(name, -1)); + fs_give((void **) &name); + } + else + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewStringObj("Unknown", -1)); + + /* file size */ + Tcl_ListObjAppendElement(interp, objAttach, + Tcl_NewLongObj((p->l.b.body->encoding == ENCBASE64) + ? ((p->l.b.body->size.bytes * 3)/4) + : p->l.b.body->size.bytes)); + + /* type/subtype */ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%s/%s", + body_type_names(p->l.b.body->type), + p->l.b.body->subtype ? p->l.b.body->subtype : "Unknown"); + Tcl_ListObjAppendElement(interp, objAttach, Tcl_NewStringObj(tmp_20k_buf, -1)); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objAttach); + } + + return(TCL_OK); + } + } + else if(objc == 3){ + if(!strcmp(s1, "unattach")){ + char *id; + + if((id = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(peClearAttachID(id)){ + Tcl_SetResult(interp, "OK", TCL_STATIC); + return(TCL_OK); + } + else + err = "Can't access attachment id"; + } + else + err = "Can't read attachment id"; + } + else if(!strcmp(s1, "attachinfo")){ + COMPATT_S *a; + char *id, *s; + + /* return: remote-filename size "type/subtype" */ + if((id = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if((a = peGetAttachID(id)) != NULL){ + if(a->file){ + /* file name */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(a->l.f.remote,-1)); + + /* file size */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewLongObj(a->l.f.size)); + + /* type/subtype */ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%s/%s", a->l.f.type, a->l.f.subtype); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(tmp_20k_buf,-1)); + + /* description */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj((a->l.f.description) ? a->l.f.description : "",-1)); + return(TCL_OK); + } + else if(a->body){ + char *name; + + /* file name */ + if((name = get_filename_parameter(NULL, 0, a->l.b.body, NULL)) != NULL){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(name, -1)); + fs_give((void **) &name); + } + else + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj("Unknown", -1)); + + /* file size */ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewLongObj((a->l.b.body->encoding == ENCBASE64) + ? ((a->l.b.body->size.bytes * 3)/4) + : a->l.b.body->size.bytes)); + + /* type/subtype */ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%s/%s", + body_type_names(a->l.b.body->type), + a->l.b.body->subtype ? a->l.b.body->subtype : "Unknown"); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(tmp_20k_buf, -1)); + + /* description */ + if(a->l.b.body->description){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%.*s", 256, a->l.b.body->description); + } + else if((s = parameter_val(a->l.b.body->parameter, "description")) != NULL){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%.*s", 256, s); + fs_give((void **) &s); + } + else + tmp_20k_buf[0] = '\0'; + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), Tcl_NewStringObj(tmp_20k_buf, -1)); + + return(TCL_OK); + } + + err = "Unknown attachment type"; + } + else + err = "Can't access attachment id"; + } + else + err = "Can't read attachment id"; + } + } + else if(objc == 7){ + if(!strcmp(s1, "attach")){ + char *file, *remote, *type, *subtype, *desc; + + if((file = Tcl_GetStringFromObj(objv[2], NULL)) + && (type = Tcl_GetStringFromObj(objv[3], NULL)) + && (subtype = Tcl_GetStringFromObj(objv[4], NULL)) + && (remote = Tcl_GetStringFromObj(objv[5], NULL))){ + int dl; + + desc = Tcl_GetStringFromObj(objv[6], &dl); + + if(desc){ + Tcl_SetResult(interp, peFileAttachID(file, type, subtype, remote, desc, dl), TCL_VOLATILE); + return(TCL_OK); + } + else + err = "Can't read file description"; + } + else + err = "Can't read file name"; + } + } + } + } + + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + +COMPATT_S * +peNewAttach(void) +{ + COMPATT_S *p = (COMPATT_S *) fs_get(sizeof(COMPATT_S)); + memset(p, 0, sizeof(COMPATT_S)); + return(p); +} + + +void +peFreeAttach(COMPATT_S **a) +{ + if(a && *a){ + fs_give((void **) &(*a)->id); + + if((*a)->file){ + if((*a)->l.f.type) + fs_give((void **) &(*a)->l.f.type); + + if((*a)->l.f.subtype) + fs_give((void **) &(*a)->l.f.subtype); + + if((*a)->l.f.remote) + fs_give((void **) &(*a)->l.f.remote); + + if((*a)->l.f.local){ + (void) unlink((*a)->l.f.local); + fs_give((void **) &(*a)->l.f.local); + } + + if((*a)->l.f.description) + fs_give((void **) &(*a)->l.f.description); + } + else if((*a)->body){ + pine_free_body(&(*a)->l.b.body); + } + + peFreeAttach(&(*a)->next); + fs_give((void **) a); + } +} + + +char * +peFileAttachID(char *f, char *t, char *st, char *r, char *d, int dl) +{ + COMPATT_S *ap = peNewAttach(), *p; + long hval; + + ap->file = TRUE; + ap->l.f.local = cpystr(f); + ap->l.f.size = name_file_size(f); + + hval = line_hash(f); + while(1) /* collisions? */ + if(peGetAttachID(ap->id = cpystr(long2string(hval)))){ + fs_give((void **) &ap->id); + hval += 1; + } + else + break; + + ap->l.f.remote = cpystr(r ? r : ""); + ap->l.f.type = cpystr(t ? t : "Text"); + ap->l.f.subtype = cpystr(st ? st : "Plain"); + + ap->l.f.description = fs_get(dl + 1); + snprintf(ap->l.f.description, dl + 1, "%s", d); + + if((p = peCompAttach) != NULL){ + do + if(!p->next){ + p->next = ap; + break; + } + while((p = p->next) != NULL); + } + else + peCompAttach = ap; + + return(ap->id); +} + + +char * +peBodyAttachID(BODY *b) +{ + COMPATT_S *ap = peNewAttach(), *p; + unsigned long hval; + + ap->body = TRUE; + ap->l.b.body = copy_body(NULL, b); + + hval = b->id ? line_hash(b->id) : time(0); + while(1) /* collisions? */ + if(peGetAttachID(ap->id = cpystr(ulong2string(hval)))){ + fs_give((void **) &ap->id); + hval += 1; + } + else + break; + + /* move contents pointer to copy */ + peBodyMoveContents(b, ap->l.b.body); + + if((p = peCompAttach) != NULL){ + do + if(!p->next){ + p->next = ap; + break; + } + while((p = p->next) != NULL); + } + else + peCompAttach = ap; + + return(ap->id); +} + + +void +peBodyMoveContents(BODY *bs, BODY *bd) +{ + if(bs && bd){ + if(bs->type == TYPEMULTIPART && bd->type == TYPEMULTIPART){ + PART *ps = bs->nested.part, + *pd = bd->nested.part; + do /* for each part */ + peBodyMoveContents(&ps->body, &pd->body); + while ((ps = ps->next) && (pd = pd->next)); /* until done */ + } + else if(bs->contents.text.data){ + bd->contents.text.data = bs->contents.text.data; + bs->contents.text.data = NULL; + } + } +} + + + +COMPATT_S * +peGetAttachID(char *h) +{ + COMPATT_S *p; + + for(p = peCompAttach; p; p = p->next) + if(!strcmp(p->id, h)) + return(p); + + return(NULL); +} + + +int +peClearAttachID(char *h) +{ + COMPATT_S *pp, *pt = NULL; + + for(pp = peCompAttach; pp; pp = pp->next){ + if(!strcmp(pp->id, h)){ + if(pt) + pt->next = pp->next; + else + peCompAttach = pp->next; + + pp->next = NULL; + peFreeAttach(&pp); + return(TRUE); + } + + pt = pp; + } + + return(FALSE); +} + + +/* + * peDoPost - handle preparing header and body text for posting, prepare + * for any Fcc, then call the mailer to send it out + */ +int +peDoPost(METAENV *metaenv, BODY *body, char *fcc, CONTEXT_S **fcc_cntxtp, char *errp) +{ + int rv = TCL_OK, recipients; + char *s; + + if(commence_fcc(fcc, fcc_cntxtp, TRUE)){ + + ps_global->c_client_error[0] = ps_global->last_error[0] = '\0'; + pePrepareForAuthException(); + + if((recipients = (metaenv->env->to || metaenv->env->cc || metaenv->env->bcc)) + && call_mailer(metaenv, body, NULL, 0, NULL, NULL) < 0){ + if(s = peAuthException()){ + strcpy(errp, s); + } + else if(ps_global->last_error[0]){ + sprintf(errp, "Send Error: %.*s", 64, ps_global->last_error); + } + else if(ps_global->c_client_error[0]){ + sprintf(errp, "Send Error: %.*s", 64, ps_global->c_client_error); + } + else + strcpy(errp, "Sending Failure"); + + rv = TCL_ERROR; + dprint((1, "call_mailer failed!")); + } + else if(fcc && fcc_cntxtp && !wrapup_fcc(fcc, *fcc_cntxtp, recipients ? NULL : metaenv, body)){ + strcpy(errp, "Fcc Failed!. No message saved."); + rv = TCL_ERROR; + dprint((1, "explicit fcc write failed!")); + } + else{ + PINEFIELD *pf; + REPLY_S *reply = NULL; + + /* success, now look for x-reply-uid to flip answered flag for? */ + + for(pf = metaenv->local; pf && pf->name; pf = pf->next) + if(!strucmp(pf->name, "x-reply-uid")){ + if(pf->textbuf){ + if((reply = (REPLY_S *) build_reply_uid(pf->textbuf)) != NULL){ + + update_answered_flags(reply); + + if(reply->mailbox) + fs_give((void **) &reply->mailbox); + + if(reply->prefix) + fs_give((void **) &reply->prefix); + + if(reply->data.uid.msgs) + fs_give((void **) &reply->data.uid.msgs); + + fs_give((void **) &reply); + } + } + + break; + } + } + } + else{ + dprint((1,"can't open fcc, cont")); + + strcpy(errp, "Can't open Fcc"); + rv = TCL_ERROR; + } + + return(rv); +} + + + +/* + * pePostponeCmd - export various bits of alpine state + */ +int +PEPostponeCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *err = "PEPostpone: unknown request"; + imapuid_t uid; + + dprint((2, "PEPostponeCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + } + else if(!ps_global){ + Tcl_SetResult(interp, "pePostpone: no config present", TCL_STATIC); + return(TCL_ERROR); + } + else{ + char *s1 = Tcl_GetStringFromObj(objv[1], NULL); + + if(s1){ + if(!strcmp(s1, "extract")){ + if(Tcl_GetLongFromObj(interp, objv[2], &uid) == TCL_OK){ + Tcl_Obj *objHdr = NULL, *objBod = NULL, *objAttach = NULL, *objOpts = NULL; + MAILSTREAM *stream; + BODY *b; + ENVELOPE *env = NULL; + PINEFIELD *custom = NULL, *cp; + REPLY_S *reply = NULL; + ACTION_S *role = NULL; + STORE_S *so; + long n; + int rv = TCL_OK; + char *fcc = NULL, *lcc = NULL; + unsigned flags = REDRAFT_DEL | REDRAFT_PPND; + + if(objc > 3){ /* optional flags */ + int i, nFlags; + Tcl_Obj **objFlags; + char *flagstr; + + Tcl_ListObjGetElements(interp, objv[3], &nFlags, &objFlags); + for(i = 0; i < nFlags; i++){ + if((flagstr = Tcl_GetStringFromObj(objFlags[i], NULL)) == NULL){ + rv = TCL_ERROR; + } + + if(!strucmp(flagstr, "html")) + flags |= REDRAFT_HTML; + } + } + /* BUG: should probably complain if argc > 4 */ + + if(rv == TCL_OK + && postponed_stream(&stream, ps_global->VAR_POSTPONED_FOLDER, "Postponed", 0) + && stream){ + if((so = so_get(CharStar, NULL, EDIT_ACCESS)) != NULL){ + if((n = mail_msgno(stream, uid)) > 0L){ + if(redraft_work(&stream, n, &env, &b, &fcc, &lcc, &reply, + NULL, &custom, &role, /* should role be NULL? */ + flags, so)){ + char *charset = NULL; + + /* prepare to package up for caller */ + objHdr = Tcl_NewListObj(0, NULL); + + /* determine body part's charset */ + if((charset = parameter_val(b->parameter,"charset")) != NULL){ + objOpts = Tcl_NewListObj(0, NULL); + peAppListF(interp, objOpts, "%s%s", "charset", charset); + fs_give((void **) &charset); + } + + /* body part's MIME subtype */ + if(b->subtype && strucmp(b->subtype,"plain")){ + if(!objOpts) + objOpts = Tcl_NewListObj(0, NULL); + + peAppListF(interp, objOpts, "%s%s", "subtype", b->subtype); + } + + peAppListF(interp, objHdr, "%s%a", "from", + role && role->from ? role->from : env->from); + peAppListF(interp, objHdr, "%s%a", "to", env->to); + peAppListF(interp, objHdr, "%s%a", "cc", env->cc); + peAppListF(interp, objHdr, "%s%a", "bcc", env->bcc); + peAppListF(interp, objHdr, "%s%s", "in-reply-to", env->in_reply_to); + peAppListF(interp, objHdr, "%s%s", "subject", + rfc1522_decode_to_utf8((unsigned char *) tmp_20k_buf, + SIZEOF_20KBUF, env->subject)); + + if(fcc) + peFccAppend(interp, objHdr, fcc, -1); + + for(cp = custom; cp && cp->name; cp = cp->next) + switch(cp->type){ + case Address : + strncpy(tmp_20k_buf, cp->name, SIZEOF_20KBUF); + tmp_20k_buf[SIZEOF_20KBUF-1] = '\0'; + peAppListF(interp, objHdr, "%s%a", + lcase((unsigned char *) tmp_20k_buf), *cp->addr); + break; + + case Attachment : + break; + + case Fcc : + case Subject : + break; /* ignored */ + + default : + strncpy(tmp_20k_buf, cp->name, SIZEOF_20KBUF); + tmp_20k_buf[SIZEOF_20KBUF-1] = '\0'; + peAppListF(interp, objHdr, "%s%s", + lcase((unsigned char *) tmp_20k_buf), cp->textbuf ? cp->textbuf : cp->val); + break; + } + + if(reply){ + /* blat x-Reply-UID: for possible use? */ + if(reply->uid){ + char uidbuf[MAILTMPLEN], *p; + long i; + + for(i = 0L, p = tmp_20k_buf; reply->data.uid.msgs[i]; i++){ + if(i) + sstrncpy(&p, ",", SIZEOF_20KBUF-(p-tmp_20k_buf)); + + sstrncpy(&p,ulong2string(reply->data.uid.msgs[i]), SIZEOF_20KBUF-(p-tmp_20k_buf)); + } + + tmp_20k_buf[SIZEOF_20KBUF-1] = '\0'; + + snprintf(uidbuf, sizeof(uidbuf), "(%s%s%s)(%ld %lu %s)%s", + reply->prefix ? int2string(strlen(reply->prefix)) + : (reply->forwarded) ? "" : "0 ", + reply->prefix ? " " : "", + reply->prefix ? reply->prefix : "", + i, reply->data.uid.validity, + tmp_20k_buf, reply->mailbox); + + peAppListF(interp, objHdr, "%s%s", "x-reply-uid", uidbuf); + } + + fs_give((void **) &reply->mailbox); + fs_give((void **) &reply->prefix); + fs_give((void **) &reply->data.uid.msgs); + fs_give((void **) &reply); + } + + objBod = Tcl_NewListObj(0, NULL); + peSoStrToList(interp, objBod, so); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objHdr); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objBod); + + objAttach = peMsgAttachCollector(interp, b); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objAttach); + + if(objOpts){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),objOpts); + } + + /* clean up */ + if(fcc) + fs_give((void **) &fcc); + + if(lcc) + fs_give((void **) &lcc); + + mail_free_envelope(&env); + pine_free_body(&b); + free_action(&role); + + /* if Drafts got whacked, open INBOX */ + if(!ps_global->mail_stream) + do_broach_folder(ps_global->inbox_name, + ps_global->context_list, + NULL, DB_INBOXWOCNTXT); + + return(TCL_OK); + } + + so_give(&so); + } + else + err = "Unknown UID"; + } + else + err = "No internal storage"; + + /* redraft_work cleaned up the "stream" */ + } + else + err = "No Postponed stream"; + } + else + err = "Malformed extract request"; + } + else if(objc == 2){ + if(!strcmp(s1, "any")){ + MAILSTREAM *stream; + + if(postponed_stream(&stream, ps_global->VAR_POSTPONED_FOLDER, "Postponed", 0) && stream){ + Tcl_SetResult(interp, "1", TCL_STATIC); + + if(stream != ps_global->mail_stream) + pine_mail_close(stream); + } + else + Tcl_SetResult(interp, "0", TCL_STATIC); + + return(TCL_OK); + } + else if(!strcmp(s1, "count")){ + MAILSTREAM *stream; + + if(postponed_stream(&stream, ps_global->VAR_POSTPONED_FOLDER, "Postponed", 0) && stream){ + Tcl_SetResult(interp, long2string(stream->nmsgs), TCL_STATIC); + + if(stream != ps_global->mail_stream) + pine_mail_close(stream); + } + else + Tcl_SetResult(interp, "-1", TCL_STATIC); + + return(TCL_OK); + } + else if(!strcmp(s1, "list")){ + MAILSTREAM *stream; + ENVELOPE *env; + Tcl_Obj *objEnv = NULL, *objEnvList; + long n; + + if(postponed_stream(&stream, ps_global->VAR_POSTPONED_FOLDER, "Postponed", 0) && stream){ + if(!stream->nmsgs){ + (void) redraft_cleanup(&stream, FALSE, REDRAFT_PPND); + Tcl_SetResult(interp, "", TCL_STATIC); + return(TCL_OK); + } + + objEnvList = Tcl_NewListObj(0, NULL); + + for(n = 1; n <= stream->nmsgs; n++){ + if((env = pine_mail_fetchstructure(stream, n, NULL)) != NULL){ + objEnv = Tcl_NewListObj(0, NULL); + + peAppListF(interp, objEnv, "%s%s", "uid", + ulong2string(mail_uid(stream, n))); + + peAppListF(interp, objEnv, "%s%a", "to", env->to); + + date_str((char *)env->date, iSDate, 1, tmp_20k_buf, SIZEOF_20KBUF, 0); + + peAppListF(interp, objEnv, "%s%s", "date", tmp_20k_buf); + + peAppListF(interp, objEnv, "%s%s", "subj", + rfc1522_decode_to_utf8((unsigned char *) tmp_20k_buf, + SIZEOF_20KBUF, env->subject)); + + Tcl_ListObjAppendElement(interp, objEnvList, objEnv); + } + } + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objEnvList); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj("utf-8", -1)); + + if(stream != ps_global->mail_stream) + pine_mail_close(stream); + } + + return(TCL_OK); + } + } + else if(objc == 3){ + if(!strcmp(s1, "append")){ + int rv; + + if((rv = peMsgCollector(interp, objc - 2, (Tcl_Obj **) &objv[2], peDoPostpone, PMC_NONE)) == TCL_OK) + Tcl_SetResult(interp, ulong2string(get_last_append_uid()), TCL_VOLATILE); + + return(rv); + } + else if(!strcmp(s1, "draft")){ + int rv; + + if((rv = peMsgCollector(interp, objc - 2, (Tcl_Obj **) &objv[2], peDoPostpone, PMC_PRSRV_ATT)) == TCL_OK) + Tcl_SetResult(interp, ulong2string(get_last_append_uid()), TCL_VOLATILE); + + return(rv); + } + else if(!strcmp(s1, "delete")){ + if(Tcl_GetLongFromObj(interp, objv[2], &uid) == TCL_OK){ + MAILSTREAM *stream; + long rawno; + + if(postponed_stream(&stream, ps_global->VAR_POSTPONED_FOLDER, "Postponed", 0) && stream){ + if((rawno = mail_msgno(stream, uid)) > 0L){ + mail_flag(stream, long2string(rawno), "\\DELETED", ST_SET); + ps_global->expunge_in_progress = 1; + mail_expunge(stream); + ps_global->expunge_in_progress = 0; + if(stream != ps_global->mail_stream) + pine_mail_actually_close(stream); + + return(TCL_OK); + } + else + err = "PEPostpone delete: UID no longer exists"; + } + else + err = "PEPostpone delete: No Postponed stream"; + } + else + err = "PEPostpone delete: No uid provided"; + } + } + } + } + + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + +/* + * peDoPostpone - handle postponing after message collection + */ +int +peDoPostpone(METAENV *metaenv, BODY *body, char *fcc, CONTEXT_S **fcc_cntxtp, char *errp) +{ + PINEFIELD *pf; + int rv; + appenduid_t *au; + + /* + * resolve fcc and store it in fcc custom header field data + */ + if(fcc && *fcc && fcc_cntxtp && *fcc_cntxtp) + for(pf = metaenv->local; pf && pf->name; pf = pf->next) + if(!strucmp("fcc", pf->name)){ + char *name, *rs, path_in_context[MAILTMPLEN]; + + if(pf->textbuf) /* free old value */ + fs_give((void **) &pf->textbuf); + + /* replace nickname with full name */ + if(!(name = folder_is_nick(fcc, FOLDERS(*fcc_cntxtp), FN_NONE))) + name = fcc; + + if(context_isambig(name) && !(((*fcc_cntxtp)->use) & CNTXT_SAVEDFLT)){ + context_apply(path_in_context, *fcc_cntxtp, name, sizeof(path_in_context)); + rs = IS_REMOTE(path_in_context) ? path_in_context : NULL; + } + else + rs = cpystr(name); + + if(rs){ + pf->textbuf = cpystr(rs); + pf->text = &pf->textbuf; + } + + break; + } + + au = mail_parameters(NIL, GET_APPENDUID, NIL); + mail_parameters(NIL, SET_APPENDUID, (void *) appenduid_cb); + + rv = write_postponed(metaenv, body); + + mail_parameters(NIL, SET_APPENDUID, (void *) au); + + return((rv < 0) ? TCL_ERROR : TCL_OK); +} + + +/* + * peMsgCollector - Collect message parts and call specified handler + */ +int +peMsgCollector(Tcl_Interp *interp, + int objc, + Tcl_Obj **objv, + int (*postfunc)(METAENV *, BODY *, char *, CONTEXT_S **, char *), + long flags) +{ + Tcl_Obj **objMsg, **objField, **objBody; + int i, j, vl, nMsg, nField, nBody; + char *field, *value, *err = NULL; + MSG_COL_S md; + PINEFIELD *pf; + STRLIST_S *tp, *lp; + static char *fakedomain = "@"; + + memset(&md, 0, sizeof(MSG_COL_S)); + md.postop_fcc_no_attach = -1; + md.postfunc = postfunc; + md.qualified_addrs = ((flags & PMC_FORCE_QUAL) == PMC_FORCE_QUAL); + + if(objc != 1){ + Tcl_SetResult(interp, "Malformed message data", TCL_STATIC); + return(TCL_ERROR); + } + else if(!ps_global){ + Tcl_SetResult(interp, "No open folder", TCL_STATIC); + return(TCL_ERROR); + } + + md.outgoing = mail_newenvelope(); + + md.metaenv = pine_new_env(md.outgoing, NULL, NULL, md.custom = peCustomHdrs()); + + Tcl_ListObjGetElements(interp, objv[0], &nMsg, &objMsg); + for(i = 0; i < nMsg; i++){ + if(Tcl_ListObjGetElements(interp, objMsg[i], &nField, &objField) != TCL_OK){ + err = ""; /* interp's result object has error message */ + return(peMsgCollected(interp, &md, err, flags)); + } + + if(nField && (field = Tcl_GetStringFromObj(objField[0], NULL))){ + if(!strcmp(field, "body")){ + if(md.msgtext){ + err = "Too many bodies"; + return(peMsgCollected(interp, &md, err, flags)); + } + else if((md.msgtext = so_get(CharStar, NULL, EDIT_ACCESS)) != NULL){ + /* mark storage object as user edited */ + (void) so_attr(md.msgtext, "edited", "1"); + + Tcl_ListObjGetElements(interp, objField[1], &nBody, &objBody); + for(j = 0; j < nBody; j++){ + value = Tcl_GetStringFromObj(objBody[j], &vl); + if(value){ + so_nputs(md.msgtext, value, vl); + so_puts(md.msgtext, "\n"); + } + else{ + err = "Value read failure"; + return(peMsgCollected(interp, &md, err, flags)); + } + } + } + else { + err = "Can't acquire body storage"; + return(peMsgCollected(interp, &md, err, flags)); + } + } + else if(!strucmp(field, "attach")){ + char *id; + COMPATT_S *a; + + if(nField == 2 + && (id = Tcl_GetStringFromObj(objField[1], NULL)) + && (a = peGetAttachID(id))){ + tp = new_strlist(id); + if((lp = md.attach) != NULL){ + do + if(!lp->next){ + lp->next = tp; + break; + } + while((lp = lp->next) != NULL); + } + else + md.attach = tp; + } + else{ + strcpy(err = tmp_20k_buf, "Unknown attachment ID"); + return(peMsgCollected(interp, &md, err, flags)); + } + } + else if(!strucmp(field, "fcc")){ + Tcl_Obj **objFcc; + int nFcc; + + if(Tcl_ListObjGetElements(interp, objField[1], &nFcc, &objFcc) == TCL_OK + && nFcc == 2 + && Tcl_GetIntFromObj(interp, objFcc[0], &md.fcc_colid) == TCL_OK + && (value = Tcl_GetStringFromObj(objFcc[1], NULL))){ + if(md.fcc) + fs_give((void **) &md.fcc); + + md.fcc = cpystr(value); + } + else { + strcpy(err = tmp_20k_buf, "Unrecognized Fcc specification"); + return(peMsgCollected(interp, &md, err, flags)); + } + } + else if(!strucmp(field, "postoption")){ + Tcl_Obj **objPO; + int nPO, ival; + + value = NULL; + if(Tcl_ListObjGetElements(interp, objField[1], &nPO, &objPO) == TCL_OK + && nPO == 2 + && (value = Tcl_GetStringFromObj(objPO[0], NULL))){ + if(!strucmp(value,"fcc-without-attachments")){ + if(Tcl_GetIntFromObj(interp, objPO[1], &ival) == TCL_OK){ + md.postop_fcc_no_attach = (ival != 0); + } + else{ + sprintf(err = tmp_20k_buf, "Malformed Post Option: fcc-without-attachments"); + return(peMsgCollected(interp, &md, err, flags)); + } + } + else if(!strucmp(value, "charset")){ + if((value = Tcl_GetStringFromObj(objPO[1], NULL)) != NULL){ + char *p; + + for(p = value; ; p++){ /* sanity check */ + if(!*p){ + md.charset = cpystr(value); + break; + } + + if(isspace((unsigned char ) *p) + || !isprint((unsigned char) *p)) + break; + + if(p - value > 255) + break; + } + } + else{ + err = "Post option read failure"; + return(peMsgCollected(interp, &md, err, flags)); + } + } + else if(!strucmp(value, "flowed")){ + if(F_OFF(F_QUELL_FLOWED_TEXT,ps_global)){ + if((value = Tcl_GetStringFromObj(objPO[1], NULL)) != NULL){ + if(!strucmp(value, "yes")) + md.flowed = 1; + } + else{ + err = "Post option read failure"; + return(peMsgCollected(interp, &md, err, flags)); + } + } + } + else if(!strucmp(value, "subtype")){ + if((value = Tcl_GetStringFromObj(objPO[1], NULL)) != NULL){ + if(!strucmp(value, "html")) + md.html = 1; + } + else{ + err = "Post option read failure"; + return(peMsgCollected(interp, &md, err, flags)); + } + } + else if(!strucmp(value, "priority")){ + if((value = Tcl_GetStringFromObj(objPO[1], NULL)) != NULL){ + char *priority = NULL; + + if(!strucmp(value, "highest")) + priority = "Highest"; + else if(!strucmp(value, "high")) + priority = "High"; + else if(!strucmp(value, "normal")) + priority = "Normal"; + else if(!strucmp(value, "low")) + priority = "Low"; + else if(!strucmp(value, "lowest")) + priority = "Lowest"; + + if(priority){ + if(pf = set_priority_header(md.metaenv, priority)) + pf->text = &pf->textbuf; + } + } + else{ + err = "Post option read failure"; + return(peMsgCollected(interp, &md, err, flags)); + } + } + else{ + sprintf(err = tmp_20k_buf, "Unknown Post Option: %s", value); + return(peMsgCollected(interp, &md, err, flags)); + } + } + else{ + sprintf(err = tmp_20k_buf, "Malformed Post Option"); + return(peMsgCollected(interp, &md, err, flags)); + } + } + else { + if(nField != 2){ + sprintf(err = tmp_20k_buf, "Malformed header (%s)", field); + return(peMsgCollected(interp, &md, err, flags)); + } + + if((value = Tcl_GetStringFromObj(objField[1], &vl)) != NULL){ + ADDRESS **addrp = NULL; + char **valp = NULL, *valcpy; + + if(!strucmp(field, "from")){ + addrp = &md.outgoing->from; + } + else if(!strucmp(field, "reply-to")){ + addrp = &md.outgoing->reply_to; + } + else if(!strucmp(field, "to")){ + addrp = &md.outgoing->to; + } + else if(!strucmp(field, "cc")){ + addrp = &md.outgoing->cc; + } + else if(!strucmp(field, "bcc")){ + addrp = &md.outgoing->bcc; + } + else if(!strucmp(field, "subject")){ + valp = &md.outgoing->subject; + } + else if(!strucmp(field, "in-reply-to")){ + valp = &md.outgoing->in_reply_to; + } + else if(!strucmp(field, "newsgroups")){ + valp = &md.outgoing->newsgroups; + } + else if(!strucmp(field, "followup-to")){ + valp = &md.outgoing->followup_to; + } + else if(!strucmp(field, "references")){ + valp = &md.outgoing->references; + } + else if(!strucmp(field, "x-reply-uid")){ + for(pf = md.metaenv->local; pf && pf->name; pf = pf->next) + if(!strucmp(pf->name, "x-reply-uid")){ + valp = pf->text = &pf->textbuf; + break; + } + } + else if(!strucmp(field, "x-auth-received")){ + for(pf = md.metaenv->local; pf && pf->name; pf = pf->next) + if(!strucmp(pf->name, "x-auth-received")){ + valp = pf->text = &pf->textbuf; + break; + } + } + else{ + for(pf = md.metaenv->custom; pf && pf->name; pf = pf->next) + if(!strucmp(field, pf->name)){ + if(pf->type == Address) + addrp = pf->addr; + else if(vl) + valp = &pf->textbuf; + else if(pf->textbuf) + fs_give((void **) &pf->textbuf); + + break; + } + + if(!pf) + dprint((2, "\nPOST: unrecognized field - %s\n", field)); + } + + if(valp){ + if(*valp) + fs_give((void **) valp); + + sprintf(*valp = fs_get((vl + 1) * sizeof(char)), "%.*s", vl, value); + } + + if(addrp){ + sprintf(valcpy = fs_get((vl + 1) * sizeof(char)), "%.*s", vl, value); + + for(; *addrp; addrp = &(*addrp)->next) + ; + + rfc822_parse_adrlist(addrp, valcpy, + (flags & PMC_FORCE_QUAL) + ? fakedomain : ps_global->maildomain); + fs_give((void **) &valcpy); + } + } + else{ + err = "Value read failure"; + return(peMsgCollected(interp, &md, err, flags)); + } + } + } + } + + return(peMsgCollected(interp, &md, err, flags)); +} + + +/* + * peMsgCollected - Dispatch collected message data and cleanup + */ +int +peMsgCollected(Tcl_Interp *interp, MSG_COL_S *md, char *err, long flags) +{ + int rv = TCL_OK, non_ascii = FALSE; + unsigned char c; + BODY *body = NULL, *tbp = NULL; + char errbuf[WP_MAX_POST_ERROR + 1], *charset; + STRLIST_S *lp; + + if(err){ + if(md->msgtext) + so_give(&md->msgtext); + + rv = TCL_ERROR; + } + else if(md->qualified_addrs && check_addresses(md->metaenv) == CA_BAD){ + sprintf(err = tmp_20k_buf, "Address must be fully qualified."); + rv = TCL_ERROR; + } + else{ + /* sniff body for possible multipart wrapping to protect encoding */ + so_seek(md->msgtext, 0L, 0); + + while(so_readc(&c, md->msgtext)) + if(!c || c & 0x80){ + non_ascii = TRUE; + break; + } + + if(!md->outgoing->from) + md->outgoing->from = generate_from(); + + rfc822_date(tmp_20k_buf); + md->outgoing->date = (unsigned char *) cpystr(tmp_20k_buf); + md->outgoing->return_path = rfc822_cpy_adr(md->outgoing->from); + md->outgoing->message_id = generate_message_id(); + + body = mail_newbody(); + + /* wire any attachments to body */ + if(md->attach || (non_ascii && F_OFF(F_COMPOSE_ALWAYS_DOWNGRADE, ps_global))){ + PART **np; + PARAMETER **pp; + COMPATT_S *a; + + /* setup slot for message text */ + body->type = TYPEMULTIPART; + body->nested.part = mail_newbody_part(); + tbp = &body->nested.part->body; + + /* link in attachments */ + for(lp = md->attach, np = &body->nested.part->next; lp; lp = lp->next, np = &(*np)->next){ + if(!(a = peGetAttachID(lp->name))){ + err = "Unknown Attachment ID"; + rv = TCL_ERROR; + break; + } + + *np = mail_newbody_part(); + + if(a->file){ + (*np)->body.id = generate_message_id(); + (*np)->body.description = cpystr(a->l.f.description); + + /* set name parameter */ + for(pp = &(*np)->body.parameter; *pp; ) + if(!struncmp((*pp)->attribute, "name", 4) + && (!*((*pp)->attribute + 4) + || *((*pp)->attribute + 4) == '*')){ + PARAMETER *free_me = *pp; + *pp = (*pp)->next; + free_me->next = NULL; + mail_free_body_parameter(&free_me); + } + else + pp = &(*pp)->next; + + *pp = NULL; + set_parameter(pp, "name", a->l.f.remote); + + /* Then set the Content-Disposition ala RFC1806 */ + if(!(*np)->body.disposition.type){ + (*np)->body.disposition.type = cpystr("attachment"); + for(pp = &(*np)->body.disposition.parameter; *pp; ) + if(!struncmp((*pp)->attribute, "filename", 4) + && (!*((*pp)->attribute + 4) + || *((*pp)->attribute + 4) == '*')){ + PARAMETER *free_me = *pp; + *pp = (*pp)->next; + free_me->next = NULL; + mail_free_body_parameter(&free_me); + } + else + pp = &(*pp)->next; + + *pp = NULL; + set_parameter(pp, "filename", a->l.f.remote); + } + + if(((*np)->body.contents.text.data = (void *) so_get(FileStar, a->l.f.local, READ_ACCESS)) != NULL){ + (*np)->body.type = mt_translate_type(a->l.f.type); + (*np)->body.subtype = cpystr(a->l.f.subtype); + (*np)->body.encoding = ENCBINARY; + (*np)->body.size.bytes = name_file_size(a->l.f.local); + + if((*np)->body.type == TYPEOTHER + && !set_mime_type_by_extension(&(*np)->body, a->l.f.local)) + set_mime_type_by_grope(&(*np)->body); + + so_release((STORE_S *)(*np)->body.contents.text.data); + } + else{ + /* unravel here */ + err = "Can't open uploaded attachment"; + rv = TCL_ERROR; + break; + } + } + else if(a->body){ + BODY *newbody = copy_body(NULL, a->l.b.body); + (*np)->body = *newbody; + fs_give((void **) &newbody); + peBodyMoveContents(a->l.b.body, &(*np)->body); + } + else{ + err = "BOTCH: Unknown attachment type"; + rv = TCL_ERROR; + break; + } + } + } + else + tbp = body; + + /* assign MIME parameters to text body part */ + tbp->type = TYPETEXT; + if(md->html) tbp->subtype = cpystr("HTML"); + + tbp->contents.text.data = (void *) md->msgtext; + tbp->encoding = ENCOTHER; + + /* set any text flowed param */ + if(md->flowed) + peMsgSetParm(&tbp->parameter, "format", "flowed"); + + if(rv == TCL_OK){ + CONTEXT_S *fcc_cntxt = ps_global->context_list; + + while(md->fcc_colid--) + if(fcc_cntxt->next) + fcc_cntxt = fcc_cntxt->next; + + if(md->postop_fcc_no_attach >= 0){ + int oldval = F_ON(F_NO_FCC_ATTACH, ps_global); + F_SET(F_NO_FCC_ATTACH, ps_global, md->postop_fcc_no_attach); + md->postop_fcc_no_attach = oldval; + } + + pine_encode_body(body); + + rv = (*md->postfunc)(md->metaenv, body, md->fcc, &fcc_cntxt, errbuf); + + if(md->postop_fcc_no_attach >= 0){ + F_SET(F_NO_FCC_ATTACH, ps_global, md->postop_fcc_no_attach); + } + + if(rv == TCL_OK){ + if((flags & PMC_PRSRV_ATT) == 0) + peFreeAttach(&peCompAttach); + } + else{ + /* maintain pointers to attachments */ + (void) peMsgAttachCollector(NULL, body); + err = errbuf; + } + } + + pine_free_body(&body); + } + + if(md->charset) + fs_give((void **) &md->charset); + + free_strlist(&md->attach); + + pine_free_env(&md->metaenv); + + if(md->custom) + free_customs(md->custom); + + mail_free_envelope(&md->outgoing); + + if(err && *err) + Tcl_SetResult(interp, err, TCL_VOLATILE); + + return(rv); +} + + +void +peMsgSetParm(PARAMETER **pp, char *pa, char *pv) +{ + for(; *pp; pp = &(*pp)->next) + if(!strucmp(pa, (*pp)->attribute)){ + if((*pp)->value) + fs_give((void **) &(*pp)->value); + + break; + } + + if(!*pp){ + *pp = mail_newbody_parameter(); + (*pp)->attribute = cpystr(pa); + } + + (*pp)->value = cpystr(pv); +} + + +Tcl_Obj * +peMsgAttachCollector(Tcl_Interp *interp, BODY *b) +{ + char *id, *name = NULL; + PART *part; + Tcl_Obj *aListObj = NULL, *aObj = NULL; + + peFreeAttach(&peCompAttach); + + if(interp) + aListObj = Tcl_NewListObj(0, NULL); + + if(b->type == TYPEMULTIPART){ + /* + * Walk first level, clipping branches and adding them + * to the attachment list... + */ + for(part = b->nested.part->next; part; part = part->next) { + id = peBodyAttachID(&part->body); + aObj = Tcl_NewListObj(0, NULL); + + if(interp){ + Tcl_ListObjAppendElement(interp, aObj, Tcl_NewStringObj(id, -1)); + + /* name */ + if((name = get_filename_parameter(NULL, 0, &part->body, NULL)) != NULL){ + Tcl_ListObjAppendElement(interp, aObj, Tcl_NewStringObj(name, -1)); + fs_give((void **) &name); + } + else + Tcl_ListObjAppendElement(interp, aObj, Tcl_NewStringObj("Unknown", -1)); + + /* size */ + Tcl_ListObjAppendElement(interp, aObj, + Tcl_NewLongObj((part->body.encoding == ENCBASE64) + ? ((part->body.size.bytes * 3)/4) + : part->body.size.bytes)); + + /* type */ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%s/%s", + body_type_names(part->body.type), + part->body.subtype ? part->body.subtype : rfc822_default_subtype (part->body.type)); + Tcl_ListObjAppendElement(interp, aObj, Tcl_NewStringObj(tmp_20k_buf, -1)); + Tcl_ListObjAppendElement(interp, aListObj, aObj); + } + } + } + + return (aListObj); +} + + +int +peFccAppend(Tcl_Interp *interp, Tcl_Obj *obj, char *fcc, int colid) +{ + Tcl_Obj *objfcc = NULL; + + if(colid < 0) + colid = (ps_global->context_list && (ps_global->context_list->use & CNTXT_INCMNG)) ? 1 : 0; + + return((objfcc = Tcl_NewListObj(0, NULL)) + && Tcl_ListObjAppendElement(interp, objfcc, Tcl_NewStringObj("fcc", -1)) == TCL_OK + && peAppListF(interp, objfcc, "%i%s", colid, fcc) == TCL_OK + && Tcl_ListObjAppendElement(interp, obj, objfcc) == TCL_OK); +} + + +/* * * * * * * * * * * * * Start of Address Management Routines * * * * * * * * * * * */ + + +/* + * PEAddressCmd - export various bits of address book/directory access + */ +int +PEAddressCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *op; + + dprint((2, "PEAddressCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + return(TCL_ERROR); + } + else if(!ps_global){ + Tcl_SetResult(interp, "PEAddress: no open folder", TCL_STATIC); + return(TCL_ERROR); + } + else if((op = Tcl_GetStringFromObj(objv[1], NULL)) != NULL){ + if(objc == 2){ + if(!strcmp(op, "safecheck")){ + if(peInitAddrbooks(interp, 1) != TCL_OK) + return(TCL_ERROR); + return(TCL_OK); + } + else if(!strcmp(op, "books")){ + int i; + + /* + * return the list of configured address books + */ + + if(peInitAddrbooks(interp, 0) != TCL_OK) + return(TCL_ERROR); + + for(i = 0; i < as.n_addrbk; i++){ + Tcl_Obj *objmv[4]; + + objmv[0] = Tcl_NewIntObj(i); + if(as.adrbks[i].abnick){ + objmv[1] = Tcl_NewStringObj(as.adrbks[i].abnick, -1); + } + else { + char buf[256]; + + snprintf(buf, sizeof(buf), "Address book number %d", i + 1); + objmv[1] = Tcl_NewStringObj(buf, -1); + } + + objmv[2] = Tcl_NewStringObj(as.adrbks[i].filename ? as.adrbks[i].filename : "", -1); + + objmv[3] = Tcl_NewIntObj(as.adrbks[i].access == ReadWrite); + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(4, objmv)); + } + + return(TCL_OK); + } + } + else if(objc == 3){ + if(!strcmp(op, "parselist")){ + char *addrstr; + ADDRESS *addrlist = NULL, *atmp, *anextp; + static char *fakedomain = "@"; + + if((addrstr = Tcl_GetStringFromObj(objv[2], NULL)) != NULL) + addrstr = cpystr(addrstr); /* can't munge tcl copy */ + + ps_global->c_client_error[0] = '\0'; + rfc822_parse_adrlist(&addrlist, addrstr, + (F_ON(F_COMPOSE_REJECTS_UNQUAL, ps_global)) + ? fakedomain : ps_global->maildomain); + + fs_give((void **) &addrstr); + if(ps_global->c_client_error[0]){ + Tcl_SetResult(interp, ps_global->c_client_error, TCL_STATIC); + return(TCL_ERROR); + } + + for(atmp = addrlist; atmp; ){ + RFC822BUFFER rbuf; + + anextp = atmp->next; + atmp->next = NULL; + tmp_20k_buf[0] = '\0'; + rbuf.f = dummy_soutr; + rbuf.s = NULL; + rbuf.beg = tmp_20k_buf; + rbuf.cur = tmp_20k_buf; + rbuf.end = tmp_20k_buf+SIZEOF_20KBUF-1; + rfc822_output_address_list(&rbuf, atmp, 0L, NULL); + *rbuf.cur = '\0'; + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(tmp_20k_buf, -1)); + atmp = anextp; + } + + mail_free_address(&addrlist); + return(TCL_OK); + } + else if(!strcmp(op, "xlookup")){ + char *addrstr; + ADDRESS *addrlist = NULL, *atmp, *anextp; + static char *fakedomain = "@"; + + if((addrstr = Tcl_GetStringFromObj(objv[2], NULL)) != NULL) + addrstr = cpystr(addrstr); /* can't munge tcl copy */ + + ps_global->c_client_error[0] = '\0'; + rfc822_parse_adrlist(&addrlist, addrstr, + (F_ON(F_COMPOSE_REJECTS_UNQUAL, ps_global)) + ? fakedomain : ps_global->maildomain); + + fs_give((void **) &addrstr); + if(ps_global->c_client_error[0]){ + Tcl_SetResult(interp, ps_global->c_client_error, TCL_STATIC); + return(TCL_ERROR); + } + + for(atmp = addrlist; atmp; ){ + anextp = atmp->next; + atmp->next = NULL; + tmp_20k_buf[0] = '\0'; + if(atmp->host){ + if(atmp->host[0] == '@'){ + /* leading ampersand means "missing-hostname" */ + } + else{ + RFC822BUFFER rbuf; + + rbuf.f = dummy_soutr; + rbuf.s = NULL; + rbuf.beg = tmp_20k_buf; + rbuf.cur = tmp_20k_buf; + rbuf.end = tmp_20k_buf+SIZEOF_20KBUF-1; + rfc822_output_address_list(&rbuf, atmp, 0L, NULL); + *rbuf.cur = '\0'; + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(tmp_20k_buf, -1)); + } + } /* else group syntax, move on */ + + atmp = anextp; + } + + mail_free_address(&addrlist); + return(TCL_OK); + } + else if(!strcmp(op, "format")){ + int i, booknum; + char buf[256], *s; + + if(peInitAddrbooks(interp, 0) != TCL_OK) + return(TCL_ERROR); + + /* + * + */ + if(Tcl_GetIntFromObj(interp, objv[2], &booknum) == TCL_OK) + for(i = 0; i < as.n_addrbk; i++) + if(i == booknum){ + addrbook_new_disp_form(&as.adrbks[booknum], ps_global->VAR_ABOOK_FORMATS, booknum, NULL); + + for(i = 0; i < NFIELDS && as.adrbks[booknum].disp_form[i].type != Notused; i++){ + switch(as.adrbks[booknum].disp_form[i].type){ + case Nickname : + s = "nick"; + break; + case Fullname : + s = "full"; + break; + case Addr : + s = "addr"; + break; + case Filecopy : + s = "fcc"; + break; + case Comment : + s = "comment"; + break; + default : + s = NULL; + break; + } + + if(s){ + Tcl_Obj *objmv[2]; + + objmv[0] = Tcl_NewStringObj(s, -1); + objmv[1] = Tcl_NewIntObj((100 * as.adrbks[booknum].disp_form[i].width) / ps_global->ttyo->screen_cols); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(2, objmv)); + } + } + + + return(TCL_OK); + } + + snprintf(buf, sizeof(buf), "PEAddress list: unknown address book number \"%d\"", booknum); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + else if(!strcmp(op, "list")){ + int i, j, k, n, booknum; + char buf[256], *s; + AdrBk_Entry *ae; + Tcl_Obj *objev[NFIELDS + 1], *objhv[2]; + + if(peInitAddrbooks(interp, 0) != TCL_OK) + return(TCL_ERROR); + + /* + * + */ + if(Tcl_GetIntFromObj(interp, objv[2], &booknum) == TCL_OK) + for(i = 0; i < as.n_addrbk; i++) + if(i == booknum){ + addrbook_new_disp_form(&as.adrbks[booknum], ps_global->VAR_ABOOK_FORMATS, booknum, NULL); + + for(i = 0; + (ae = adrbk_get_ae(as.adrbks[booknum].address_book, i)); + i++){ + + /* first member is type: Single, List or Lookup */ + switch(ae->tag){ + case Single : + s = "single"; + break; + case List : + s = "list"; + break; + default : /* not set!?! */ + continue; + } + + if(!ae->nickname) + continue; + + objhv[0] = Tcl_NewStringObj(ae->nickname, -1); + objhv[1] = Tcl_NewStringObj(s, -1); + objev[n = 0] = Tcl_NewListObj(2, objhv); + + /* + * set fields based on VAR_ABOOK_FORMATS + */ + + for(j = 0; j < NFIELDS && as.adrbks[booknum].disp_form[j].type != Notused; j++){ + switch(as.adrbks[booknum].disp_form[j].type){ + case Nickname : + objev[++n] = Tcl_NewStringObj(ae->nickname, -1); + break; + case Fullname : + objev[++n] = Tcl_NewStringObj(ae->fullname, -1); + break; + case Addr : + if(ae->tag == Single){ + objev[++n] = Tcl_NewStringObj(ae->addr.addr, -1); + } + else{ + Tcl_Obj **objav; + + for(k = 0; ae->addr.list[k]; k++) + ; + + objav = (Tcl_Obj **) fs_get(k * sizeof(Tcl_Obj *)); + for(k = 0; ae->addr.list[k]; k++) + objav[k] = Tcl_NewStringObj(ae->addr.list[k], -1); + + objev[++n] = Tcl_NewListObj(k, objav); + fs_give((void **) &objav); + } + break; + case Filecopy : + objev[++n] = Tcl_NewStringObj(ae->fcc ? ae->fcc : "", -1); + break; + case Comment : + objev[++n] = Tcl_NewStringObj(ae->extra ? ae->extra : "", -1); + break; + default : + s = NULL; + break; + } + } + + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewListObj(n + 1, objev)); + } + + return(TCL_OK); + } + + snprintf(buf, sizeof(buf), "PEAddress list: unknown address book number \"%d\"", booknum); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + } + else if(objc == 4){ + if(!strcmp(op, "verify")){ + /* + * The object here is to check the following list of field values + * to see that they are valid address list, expanding if necessary. + * The first argument is the list of field values, with "to" being + * first. The second arg is the current fcc value. + * + * The return value is of the following form: + * + * { {{errstr {{oldstr newstr {ldap-opts ...}} ...}} ...} newfcc} + */ + Tcl_Obj **objVal; + char *addrstr, *newaddr = NULL, *error = NULL, + *tstr1, *tstr2, *fcc, *newfcc = NULL; + BuildTo toaddr; + int rv, badadrs, i , numlistvals, + numldapqueries = 0; + Tcl_Obj *resObj = NULL, *secObj, *strObj, *adrObj, *res2Obj; +#ifdef ENABLE_LDAP + WPLDAPRES_S **tsl; + + wpldap_global->query_no++; + if(wpldap_global->ldap_search_list){ + wpldap_global->ldap_search_list = + free_wpldapres(wpldap_global->ldap_search_list); + } + + tsl = &(wpldap_global->ldap_search_list); +#endif /* ENABLE_LDAP */ + + if(Tcl_ListObjGetElements(interp, objv[2], &numlistvals, + &objVal) == TCL_OK){ + if((fcc = Tcl_GetStringFromObj(objv[3], NULL)) == NULL) + return TCL_ERROR; + res2Obj = Tcl_NewListObj(0, NULL); + for(i = 0; i < numlistvals; i++){ + size_t l; + + if((addrstr = Tcl_GetStringFromObj(objVal[i], NULL)) == NULL) + return TCL_ERROR; + + addrstr = cpystr(addrstr); /* can't munge tcl copy */ + toaddr.type = Str; + toaddr.arg.str = cpystr(addrstr); + l = strlen(addrstr); + badadrs = 0; + resObj = Tcl_NewListObj(0, NULL); + secObj = Tcl_NewListObj(0, NULL); + for(tstr1 = addrstr; tstr1; tstr1 = tstr2){ + tstr2 = strqchr(tstr1, ',', 0, -1); + if(tstr2) + *tstr2 = '\0'; + + strncpy(toaddr.arg.str, tstr1, l); + toaddr.arg.str[l] = '\0'; + + removing_leading_and_trailing_white_space(toaddr.arg.str); + if(*toaddr.arg.str){ + if(i == 0 && tstr1 == addrstr) + newfcc = cpystr(fcc); + + rv = our_build_address(toaddr, &newaddr, &error, &newfcc, NULL); + + if(rv == 0){ + strObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, strObj, + Tcl_NewStringObj(toaddr.arg.str, -1)); + Tcl_ListObjAppendElement(interp, strObj, + Tcl_NewStringObj(newaddr,-1)); + /* append whether or not ldap stuff + * was returned + */ + adrObj = Tcl_NewListObj(0,NULL); +#ifdef ENABLE_LDAP + if(*tsl) { + LDAP_CHOOSE_S *tres; + LDAP_SERV_RES_S *trl; + LDAPMessage *e; + ADDRESS *newadr; + char *ret_to; + + tres = (LDAP_CHOOSE_S *)fs_get(sizeof(LDAP_CHOOSE_S)); + for(trl = (*tsl)->reslist; trl; + trl = trl->next){ + for(e = ldap_first_entry(trl->ld, + trl->res); + e != NULL; + e = ldap_next_entry(trl->ld, e)){ + tres->ld = trl->ld; + tres->selected_entry = e; + tres->info_used = trl->info_used; + tres->serv = trl->serv; + if((newadr = address_from_ldap(tres)) != NULL){ + if(newadr->mailbox && newadr->host){ + RFC822BUFFER rbuf; + size_t len; + + len = est_size(newadr); + ret_to = (char *)fs_get(len * sizeof(char)); + ret_to[0] = '\0'; + rbuf.f = dummy_soutr; + rbuf.s = NULL; + rbuf.beg = ret_to; + rbuf.cur = ret_to; + rbuf.end = ret_to+len-1; + rfc822_output_address_list(&rbuf, newadr, 0L, NULL); + *rbuf.cur = '\0'; + Tcl_ListObjAppendElement(interp, + adrObj, Tcl_NewStringObj(ret_to, -1)); + fs_give((void **)&ret_to); + } + mail_free_address(&newadr); + } + } + } + fs_give((void **)&tres); + numldapqueries++; + tsl = &((*tsl)->next); + } +#endif /* ENABLE_LDAP */ + Tcl_ListObjAppendElement(interp, strObj, adrObj); + Tcl_ListObjAppendElement(interp, secObj, strObj); + } + else { + badadrs = 1; + break; + } + } + if(tstr2){ + *tstr2 = ','; + tstr2++; + } + } + resObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(badadrs + ? (error ? error : "Unknown") + : "", -1)); + Tcl_ListObjAppendElement(interp, resObj, secObj); + Tcl_ListObjAppendElement(interp, res2Obj, resObj); + fs_give((void **) &addrstr); + fs_give((void **) &toaddr.arg.str); + } + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), res2Obj); + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(newfcc ? newfcc + : (fcc ? fcc : ""), -1)); + if(newfcc) fs_give((void **)&newfcc); + return(TCL_OK); + } + return(TCL_ERROR); + } + else if(!strcmp(op, "expand")){ + BuildTo toaddr; + char *addrstr, *newaddr = NULL, *error = NULL, *fcc, *newfcc = NULL; + int rv; + + /* + * Return value will be of the form: + * {"addrstr", + * ldap-query-number, + * "fcc" + * } + * + * ldap-query-number will be nonzero if + * there is something interesting to display as a result + * of an ldap query. + */ + + /* + * Given what looks like an rfc822 address line, parse the + * contents and expand any tokens that look like they ought + * to be. + */ + + if((addrstr = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + toaddr.type = Str; + toaddr.arg.str = cpystr(addrstr); /* can't munge tcl copy */ + fcc = Tcl_GetStringFromObj(objv[3], NULL); +#ifdef ENABLE_LDAP + wpldap_global->query_no++; + if(wpldap_global->ldap_search_list){ + wpldap_global->ldap_search_list = + free_wpldapres(wpldap_global->ldap_search_list); + } +#endif /* ENABLE_LDAP */ + newfcc = cpystr(fcc); + rv = our_build_address(toaddr, &newaddr, &error, &newfcc, NULL); + fs_give((void **) &toaddr.arg.str); + if(rv == 0){ +#ifdef ENABLE_LDAP + /* + * c-client quotes results with spaces in them, so we'll go + * through and unquote them. + */ + if(wpldap_global->ldap_search_list){ + WPLDAPRES_S *tres; + char *tstr1, *tstr2; + char *qstr1, *newnewaddr; + int qstr1len; + + for(tres = wpldap_global->ldap_search_list; + tres; tres = tres->next){ + if(strqchr(tres->str, ' ', 0, -1)){ + qstr1len = strlen(tres->str) + 3; + qstr1 = (char *)fs_get(qstr1len*sizeof(char)); + snprintf(qstr1, qstr1len, "\"%.*s\"", qstr1len, tres->str); + for(tstr1 = newaddr; tstr1; tstr1 = tstr2){ + tstr2 = strqchr(tstr1, ',', 0, -1); + if(strncmp(qstr1, tstr1, tstr2 ? tstr2 - tstr1 + : strlen(tstr1)) == 0){ + size_t l; + l = strlen(newaddr) + strlen(tres->str) + 2 + + (tstr2 ? strlen(tstr2) : 0); + newnewaddr = (char *) fs_get(l * sizeof(char)); + snprintf(newnewaddr, l, "%.*s%s%s", tstr1 - newaddr, + newaddr, tres->str, tstr2 ? tstr2 : ""); + fs_give((void **)&newaddr); + newaddr = newnewaddr; + break; + } + if(tstr2) + tstr2++; + if(tstr2 && *tstr2 == ' ') + tstr2++; + } + if(qstr1) + fs_give((void **) &qstr1); + } + } + } +#endif /* ENABLE_LDAP */ + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(newaddr, -1)) != TCL_OK) + return(TCL_ERROR); +#ifdef ENABLE_LDAP + if(wpldap_global->ldap_search_list){ + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewIntObj(wpldap_global->query_no)) != TCL_OK) + return(TCL_ERROR); + } + else +#endif /* ENABLE_LDAP */ + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewIntObj(0)) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(newfcc ? newfcc + : (fcc ? fcc : ""), -1)) != TCL_OK) + return(TCL_ERROR); + if(newfcc) fs_give((void **)&newfcc); + + return(TCL_OK); + } + else{ + Tcl_SetResult(interp, error ? error : "Indeterminate error", TCL_VOLATILE); + if(newfcc) fs_give((void **)&newfcc); + return(TCL_ERROR); + } + } + } + else if(!strcmp(op, "complete")){ + /* + * CMD: complete uid + * + * Look for possible completions for + * given query_string. + * + * ARGS: <query_string> <uid> + * + * Returns: candidate list: {nickname {personal mailbox}} + */ + char *query, *errstr; + long uid; + COMPLETE_S *completions, *cp; + + if(peInitAddrbooks(interp, 0) == TCL_OK){ + if((query = Tcl_GetStringFromObj(objv[2], NULL)) != NULL){ + if(Tcl_GetLongFromObj(interp, objv[3], &uid) == TCL_OK){ + + completions = adrbk_list_of_completions(query, + ps_global->mail_stream, + uid, +#ifdef ENABLE_LDAP + ((strlen(query) >= 5) ? ALC_INCLUDE_LDAP : 0) | +#endif /* ENABLE_LDAP */ + 0); + + if(completions){ + for(cp = completions; cp; cp = cp->next) + peAppListF(interp, Tcl_GetObjResult(interp), "%s %s %s", + cp->nickname ? cp->nickname : "", + cp->full_address ? cp->full_address : "", + cp->fcc ? cp->fcc : ""); + + free_complete_s(&completions); + } + else + Tcl_SetResult(interp, "", TCL_STATIC); + + return(TCL_OK); + } + else + errstr = "PEAddress: Cannot read UID"; + } + else + errstr = "PEAddress: Cannot get completion query"; + } + else + errstr = "PEAddress: Address Book initialization failed"; + + Tcl_SetResult(interp, errstr, TCL_STATIC); + return(TCL_ERROR); + } + } + else if(objc == 5){ + if(!strcmp(op, "entry")){ + int booknum, i, aindex; + char *nick, *astr = NULL, *errstr = NULL, *fccstr = NULL, buf[128]; + AdrBk_Entry *ae; + BuildTo bldto; + + if(peInitAddrbooks(interp, 0) != TCL_OK) + return(TCL_ERROR); + + /* + * Given an address book handle and nickname, return address + */ + if(Tcl_GetIntFromObj(interp, objv[2], &booknum) == TCL_OK) + for(i = 0; i < as.n_addrbk; i++) + if(i == booknum){ + if((nick = Tcl_GetStringFromObj(objv[3], NULL)) == NULL){ + Tcl_SetResult(interp, "PEAddress list: Can't get nickname", TCL_STATIC); + return(TCL_ERROR); + } + if(Tcl_GetIntFromObj(interp, objv[4], &aindex) != TCL_OK + || (*nick == '\0' && aindex < 0)){ + Tcl_SetResult(interp, "PEAddress list: Can't get aindex", TCL_STATIC); + return(TCL_ERROR); + } + if((*nick) + ? (ae = adrbk_lookup_by_nick(as.adrbks[booknum].address_book, nick, NULL)) + : (ae = adrbk_get_ae(as.adrbks[booknum].address_book, aindex))){ + bldto.type = Abe; + bldto.arg.abe = ae; + + (void) our_build_address(bldto, &astr, &errstr, &fccstr, NULL); + + if(errstr){ + if(astr) + fs_give((void **) &astr); + + Tcl_SetResult(interp, errstr, TCL_VOLATILE); + return(TCL_ERROR); + } + + if(astr){ + char *p; + int l; + + l = (4*strlen(astr) + 1) * sizeof(char); + p = (char *) fs_get(l); + if(rfc1522_decode_to_utf8((unsigned char *) p, l, astr) == (unsigned char *) p){ + fs_give((void **) &astr); + astr = p; + } + else + fs_give((void **)&p); + } + } + + if(astr){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(astr, -1)); + fs_give((void **) &astr); + + if(fccstr){ + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(*fccstr ? fccstr : "\"\"", -1)); + fs_give((void **) &fccstr); + } + else + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj("", -1)); + } + else + Tcl_SetResult(interp, "", TCL_STATIC); + + return(TCL_OK); + } + + snprintf(buf, sizeof(buf), "PEAddress list: unknown address book ID %d", booknum); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + else if(!strcmp(op, "fullentry")){ + int booknum, j, aindex; + char *nick; + AdrBk_Entry *ae; + Tcl_Obj *resObj; + + if(peInitAddrbooks(interp, 0) != TCL_OK) + return(TCL_ERROR); + + /* + * Given an address book handle and nickname, return + * nickname, fullname, address(es), fcc, and comments + */ + if(Tcl_GetIntFromObj(interp, objv[2], &booknum) == TCL_OK){ + if(booknum >= 0 && booknum < as.n_addrbk){ + if((nick = Tcl_GetStringFromObj(objv[3], NULL)) == NULL) + return(TCL_ERROR); + if(Tcl_GetIntFromObj(interp, objv[4], &aindex) != TCL_OK + || (*nick == '\0' && aindex < 0)) + return(TCL_ERROR); + if((*nick) + ? (ae = adrbk_lookup_by_nick(as.adrbks[booknum].address_book, nick, NULL)) + : (ae = adrbk_get_ae(as.adrbks[booknum].address_book, aindex))){ + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ae->nickname ? ae->nickname : "", -1)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ae->fullname ? ae->fullname : "", -1)); + resObj = Tcl_NewListObj(0,NULL); + if(ae->tag == Single) + Tcl_ListObjAppendElement(interp, + resObj, + Tcl_NewStringObj(ae->addr.addr ? ae->addr.addr : "", -1)); + else { + for(j = 0; ae->addr.list[j]; j++) + Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(ae->addr.list[j] ? ae->addr.list[j] : "", -1)); + } + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), resObj); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ae->fcc ? ae->fcc : "", -1)); + Tcl_ListObjAppendElement(interp, + Tcl_GetObjResult(interp), + Tcl_NewStringObj(ae->extra ? ae->extra : "", -1)); + return(TCL_OK); + } + } + } + return(TCL_ERROR); + } + else if(!strcmp(op, "delete")){ + char *nick, buf[256]; + int booknum, aindex; + adrbk_cntr_t old_entry; + AdrBk *ab; + if(peInitAddrbooks(interp, 0) != TCL_OK){ + snprintf(buf, sizeof(buf), "PEAddress delete: couldn't init addressbooks"); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + if(Tcl_GetIntFromObj(interp, objv[2], &booknum) == TCL_OK){ + nick = Tcl_GetStringFromObj(objv[3], NULL); + removing_leading_and_trailing_white_space(nick); + } + else + return(TCL_ERROR); + if(booknum >= 0 && booknum < as.n_addrbk) { + if(as.adrbks[booknum].access != ReadWrite) return TCL_ERROR; + ab = as.adrbks[booknum].address_book; + } + else{ + snprintf(buf, sizeof(buf), "PEAddress delete: Book number out of range"); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + if((Tcl_GetIntFromObj(interp, objv[4], &aindex) != TCL_OK) + || (*nick == '\0' && aindex < 0)) + return(TCL_ERROR); + adrbk_check_validity(ab, 1L); + if(ab->flags & FILE_OUTOFDATE || + (ab->rd && ab->rd->flags & REM_OUTOFDATE)){ + Tcl_SetResult(interp, + "Address book out of sync. Cannot update at this moment", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(!nick){ + snprintf(buf, sizeof(buf), "PEAddress delete: No nickname"); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + if((*nick) + ? (!adrbk_lookup_by_nick(ab, nick, &old_entry)) + : ((old_entry = (adrbk_cntr_t)aindex) == -1)){ + snprintf(buf, sizeof(buf), "PEAddress delete: Nickname \"%.128s\" not found", nick); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + if(adrbk_delete(ab, old_entry, 0, 0, 1, 1)){ + snprintf(buf, sizeof(buf), "PEAddress delete: Couldn't delete addressbook entry"); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + return(TCL_OK); + } + } + else if((objc == 10 || objc == 11) && !strcmp(op, "edit")){ + if(!strcmp(op, "edit")){ + int booknum, adri, add, rv, aindex; + char *nick, *fn, *fcc, *comment, *addrfield, + buf[256], **addrs, *orignick = NULL; + AdrBk_Entry *ae = NULL; + AdrBk *ab; + adrbk_cntr_t old_entry = NO_NEXT, new_entry; + Tag tag; + ADDRESS *adr = NULL; + + + if(peInitAddrbooks(interp, 0) != TCL_OK) + return(TCL_ERROR); + if(Tcl_GetIntFromObj(interp, objv[2], &booknum) == TCL_OK){ + if(as.adrbks[booknum].access != ReadWrite) return TCL_ERROR; + nick = Tcl_GetStringFromObj(objv[3], NULL); + removing_leading_and_trailing_white_space(nick); + if(Tcl_GetIntFromObj(interp, objv[4], &aindex) != TCL_OK){ + Tcl_SetResult(interp, "No Address Handle", TCL_VOLATILE); + return(TCL_ERROR); + } + fn = Tcl_GetStringFromObj(objv[5], NULL); + removing_leading_and_trailing_white_space(fn); + if(!*fn) fn = NULL; + addrfield = Tcl_GetStringFromObj(objv[6], NULL); + removing_leading_and_trailing_white_space(addrfield); + if(!*addrfield) addrfield = NULL; + /* + if(Tcl_ListObjGetElements(interp, objv[7], &numlistvals, &objVal) != TCL_OK) + return(TCL_ERROR); + */ + fcc = Tcl_GetStringFromObj(objv[7], NULL); + removing_leading_and_trailing_white_space(fcc); + if(!*fcc) fcc = NULL; + comment = Tcl_GetStringFromObj(objv[8], NULL); + removing_leading_and_trailing_white_space(comment); + if(!*comment) comment = NULL; + if(Tcl_GetIntFromObj(interp, objv[9], &add) != TCL_OK) + return(TCL_ERROR); + if(objc == 11) { + /* + * if objc == 11 then that means that they changed the + * value of nick to something else, and this one is the + * original nick + */ + orignick = Tcl_GetStringFromObj(objv[10], NULL); + removing_leading_and_trailing_white_space(orignick); + } + if((addrs = parse_addrlist(addrfield)) != NULL){ + int tbuflen = strlen(addrfield); + char *tbuf; + if(!(tbuf = (char *) fs_get(sizeof(char) * (tbuflen+128)))){ + Tcl_SetResult(interp, "malloc error", TCL_VOLATILE); + fs_give((void **) &addrs); + return(TCL_ERROR); + } + for(adri = 0; addrs[adri]; adri++){ + if(*(addrs[adri])){ + ps_global->c_client_error[0] = '\0'; + strncpy(tbuf, addrs[adri], tbuflen+128); + tbuf[tbuflen+128-1] = '\0'; + rfc822_parse_adrlist(&adr, tbuf, "@"); + if(adr) mail_free_address(&adr); + adr = NULL; + if(ps_global->c_client_error[0]){ + snprintf(buf, sizeof(buf),"Problem with address %.10s%s: %s", + addrs[adri], strlen(addrs[adri]) > 10 ? + "..." : "", ps_global->c_client_error); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + if(tbuf) + fs_give((void **) &tbuf); + fs_give((void **) &addrs); + return(TCL_ERROR); + } + } + } + if(tbuf) fs_give((void **)&tbuf); + } + else adri = 0; + + /* addrs[adri] = NULL; */ + + if(adri > 1) tag = List; + else tag = Single; + + if(booknum >= 0 && booknum < as.n_addrbk) { + ab = as.adrbks[booknum].address_book; + } + else{ + if(addrs) + fs_give((void **) &addrs); + return(TCL_ERROR); + } + adrbk_check_validity(ab, 1L); + if(ab->flags & FILE_OUTOFDATE || + (ab->rd && ab->rd->flags & REM_OUTOFDATE)){ + Tcl_SetResult(interp, + "Address book out of sync. Cannot update at this moment", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(aindex >= 0){ + ae = adrbk_get_ae(as.adrbks[booknum].address_book, aindex); + if(ae){ + old_entry = (adrbk_cntr_t) aindex; + } + else{ + Tcl_SetResult(interp, "No Address Handle!", TCL_VOLATILE); + return(TCL_ERROR); + } + } + else if(nick && *nick && adrbk_lookup_by_nick(ab, nick, NULL)){ + snprintf(buf, sizeof(buf), "Entry with nickname %.128s already exists.", + nick); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + if(addrs) + fs_give((void **) &addrs); + return(TCL_ERROR); + } + if(ae && + ((tag == List && ae->tag == Single) || + (tag == Single && ae->tag == List))){ + if(adrbk_delete(ab, old_entry, 0,0,1,0)){ + snprintf(buf, sizeof(buf), "Problem updating from %s to %s.", + ae->tag == Single ? "Single" : "List", + tag == List ? "List" : "Single"); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + if(addrs) + fs_give((void **) &addrs); + return(TCL_ERROR); + } + old_entry = NO_NEXT; + } + if((rv = adrbk_add(ab, old_entry, + nick ? nick : "", + fn ? fn : "", + tag == List ? (char *)addrs : + (addrs && *addrs) ? *addrs : "", + fcc ? fcc : "", + comment ? comment : "", + tag, &new_entry, NULL, 0, 1, + tag == List ? 0 : 1)) != 0){ + snprintf(buf, sizeof(buf), "Couldn't add entry! rv=%d.", rv); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + if(addrs) + fs_give((void **) &addrs); + return(TCL_ERROR); + } + if(tag == List) { + adrbk_listdel_all(ab, new_entry); + adrbk_nlistadd(ab, new_entry, NULL, NULL, addrs, 0, 1, 1); + } + return(TCL_OK); + } + snprintf(buf, sizeof(buf), "Unknown address book ID %d", booknum); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + return(TCL_ERROR); + } + } + } + + Tcl_SetResult(interp, "PEAddress: unrecognized command", TCL_STATIC); + return(TCL_ERROR); +} + + +int +peInitAddrbooks(Tcl_Interp *interp, int safe) +{ + if(ps_global->remote_abook_validity > 0) + (void)adrbk_check_and_fix_all(safe, 0, 0); + + if(!init_addrbooks(NoDisplay, 1, 1, 0)){ + Tcl_SetResult(interp, "No Address Book Configured", TCL_STATIC); + return(TCL_ERROR); + } + + return(TCL_OK); +} + + + +int +peRuleStatVal(char *str, int *n) +{ + if(!str) + return(1); + + if(!strcmp(str, "either")) + *n = PAT_STAT_EITHER; + else if(!strcmp(str, "yes")) + *n = PAT_STAT_YES; + else if(!strcmp(str, "no")) + *n = PAT_STAT_NO; + else + return 1; + + return 0; +} + + +#define RS_RULE_EDIT 0x0001 +#define RS_RULE_ADD 0x0002 +#define RS_RULE_DELETE 0x0004 +#define RS_RULE_SHUFFUP 0x0008 +#define RS_RULE_SHUFFDOWN 0x0010 +#define RS_RULE_GETPAT 0x0100 +#define RS_RULE_FINDPAT 0x0200 + +int +peRuleSet(Tcl_Interp *interp, Tcl_Obj **objv) +{ + char *rule, *patvar, *patval, *actvar, *actval, *tstr, *ruleaction; + int rno, nPat, nPatEmnt, nAct, nActEmnt, i, rv = 0; + Tcl_Obj **objPat, **objPatEmnt, **objAct, **objActEmnt; + long rflags = PAT_USE_CHANGED, aflags = 0; + PAT_STATE pstate; + PAT_S *pat, *new_pat; + + if(!(rule = Tcl_GetStringFromObj(objv[0], NULL))) + return(TCL_ERROR); + + if(!(ruleaction = Tcl_GetStringFromObj(objv[1], NULL))) + return(TCL_ERROR); + + if(Tcl_GetIntFromObj(interp, objv[2], &rno) == TCL_ERROR) + return(TCL_ERROR); + + if(!(strcmp(rule, "filter"))) + rflags |= ROLE_DO_FILTER; + else if(!(strcmp(rule, "score"))) + rflags |= ROLE_DO_SCORES; + else if(!(strcmp(rule, "indexcolor"))) + rflags |= ROLE_DO_INCOLS; + else + return(TCL_ERROR); + + if(!(strcmp(ruleaction, "edit"))){ + aflags |= RS_RULE_EDIT; + aflags |= RS_RULE_GETPAT; + aflags |= RS_RULE_FINDPAT; + } + else if(!(strcmp(ruleaction, "add"))){ + aflags |= RS_RULE_ADD; + aflags |= RS_RULE_GETPAT; + } + else if(!(strcmp(ruleaction, "delete"))){ + aflags |= RS_RULE_DELETE; + aflags |= RS_RULE_FINDPAT; + } + else if(!(strcmp(ruleaction, "shuffup"))){ + aflags |= RS_RULE_SHUFFUP; + aflags |= RS_RULE_FINDPAT; + } + else if(!(strcmp(ruleaction, "shuffdown"))){ + aflags |= RS_RULE_SHUFFDOWN; + aflags |= RS_RULE_FINDPAT; + } + else return(TCL_ERROR); + + if(aflags & RS_RULE_FINDPAT){ + if(any_patterns(rflags, &pstate)){ + for(pat = first_pattern(&pstate), i = 0; + pat && i != rno; + pat = next_pattern(&pstate), i++); + if(i != rno) return(TCL_ERROR); + } + } + if(aflags & RS_RULE_GETPAT){ + int tcl_error = 0; + + Tcl_ListObjGetElements(interp, objv[3], &nPat, &objPat); + Tcl_ListObjGetElements(interp, objv[4], &nAct, &objAct); + + new_pat = (PAT_S *)fs_get(sizeof(PAT_S)); + memset(new_pat, 0, sizeof(PAT_S)); + new_pat->patgrp = (PATGRP_S *)fs_get(sizeof(PATGRP_S)); + memset(new_pat->patgrp, 0, sizeof(PATGRP_S)); + new_pat->action = (ACTION_S *)fs_get(sizeof(ACTION_S)); + memset(new_pat->action, 0, sizeof(ACTION_S)); + + /* Set up the pattern group */ + for(i = 0; i < nPat; i++){ + Tcl_ListObjGetElements(interp, objPat[i], &nPatEmnt, &objPatEmnt); + if(nPatEmnt != 2) return(TCL_ERROR); + patvar = Tcl_GetStringFromObj(objPatEmnt[0], NULL); + patval = Tcl_GetStringFromObj(objPatEmnt[1], NULL); + if(!patvar || !patval) return(TCL_ERROR); + + tstr = NULL; + if(*patval){ + tstr = cpystr(patval); + removing_leading_and_trailing_white_space(tstr); + if(!(*tstr)) + fs_give((void **) &tstr); + } + + if(!(strcmp(patvar, "nickname"))){ + new_pat->patgrp->nick = tstr; + tstr = NULL; + } + else if(!(strcmp(patvar, "comment"))){ + new_pat->patgrp->comment = tstr; + tstr = NULL; + } + else if(!(strcmp(patvar, "to"))){ + new_pat->patgrp->to = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "from"))){ + new_pat->patgrp->from = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "sender"))){ + new_pat->patgrp->sender = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "cc"))){ + new_pat->patgrp->cc = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "recip"))){ + new_pat->patgrp->recip = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "partic"))){ + new_pat->patgrp->partic = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "news"))){ + new_pat->patgrp->news = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "subj"))){ + new_pat->patgrp->subj = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "bodytext"))){ + new_pat->patgrp->bodytext = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "alltext"))){ + new_pat->patgrp->alltext = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "keyword"))){ + new_pat->patgrp->keyword = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "charset"))){ + new_pat->patgrp->charsets = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "ftype"))){ + if(!tstr) return(TCL_ERROR); + + if(!(strcmp(tstr, "any"))) + new_pat->patgrp->fldr_type = FLDR_ANY; + else if(!(strcmp(tstr, "news"))) + new_pat->patgrp->fldr_type = FLDR_NEWS; + else if(!(strcmp(tstr, "email"))) + new_pat->patgrp->fldr_type = FLDR_EMAIL; + else if(!(strcmp(tstr, "specific"))) + new_pat->patgrp->fldr_type = FLDR_SPECIFIC; + else{ + free_pat(&new_pat); + return(TCL_ERROR); + } + } + else if(!(strcmp(patvar, "folder"))){ + new_pat->patgrp->folder = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "stat_new"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_new)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "stat_rec"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_rec)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "stat_del"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_del)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "stat_imp"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_imp)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "stat_ans"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_ans)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "stat_8bitsubj"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_8bitsubj)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "stat_bom"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_bom)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "stat_boy"))){ + if(peRuleStatVal(tstr, &new_pat->patgrp->stat_boy)){ + free_pat(&new_pat); + tcl_error++; + } + } + else if(!(strcmp(patvar, "age"))){ + new_pat->patgrp->age = parse_intvl(tstr); + } + else if(!(strcmp(patvar, "size"))){ + new_pat->patgrp->size = parse_intvl(tstr); + } + else if(!(strcmp(patvar, "score"))){ + new_pat->patgrp->score = parse_intvl(tstr); + } + else if(!(strcmp(patvar, "addrbook"))){ + if(tstr){ + if(!strcmp(tstr, "either")) + new_pat->patgrp->inabook = IAB_EITHER; + else if(!strcmp(tstr, "yes")) + new_pat->patgrp->inabook = IAB_YES; + else if(!strcmp(tstr, "no")) + new_pat->patgrp->inabook = IAB_NO; + else if(!strcmp(tstr, "yesspecific")) + new_pat->patgrp->inabook = IAB_SPEC_YES; + else if(!strcmp(tstr, "nospecific")) + new_pat->patgrp->inabook = IAB_SPEC_NO; + else + tcl_error++; + } + else + tcl_error++; + + if(tcl_error) + free_pat(&new_pat); + } + else if(!(strcmp(patvar, "specificabook"))){ + new_pat->patgrp->abooks = string_to_pattern(tstr); + } + else if(!(strcmp(patvar, "headers"))){ + ARBHDR_S **ahp; + int nHdrList, nHdrPair, n; + Tcl_Obj **objHdrList, **objHdrPair; + + Tcl_ListObjGetElements(interp, objPatEmnt[1], &nHdrList, &objHdrList); + + for(ahp = &new_pat->patgrp->arbhdr; *ahp; ahp = &(*ahp)->next) + ; + + for (n = 0; n < nHdrList; n++){ + char *hdrfld; + char *hdrval; + + Tcl_ListObjGetElements(interp, objHdrList[n], &nHdrPair, &objHdrPair); + if(nHdrPair != 2) + continue; + + hdrfld = Tcl_GetStringFromObj(objHdrPair[0], NULL); + hdrval = Tcl_GetStringFromObj(objHdrPair[1], NULL); + + if(hdrfld){ + *ahp = (ARBHDR_S *) fs_get(sizeof(ARBHDR_S)); + memset(*ahp, 0, sizeof(ARBHDR_S)); + + (*ahp)->field = cpystr(hdrfld); + if(hdrval){ + (*ahp)->p = string_to_pattern(hdrval); + } + else + (*ahp)->isemptyval = 1; + + ahp = &(*ahp)->next; + } + } + } + else{ + free_pat(&new_pat); + tcl_error++; + } + + if(tstr) + fs_give((void **) &tstr); + + if(tcl_error) + return(TCL_ERROR); + } + + if((new_pat->patgrp->inabook & (IAB_SPEC_YES | IAB_SPEC_NO)) == 0 + && new_pat->patgrp->abooks) + free_pattern(&new_pat->patgrp->abooks); + + if(new_pat->patgrp->fldr_type != FLDR_SPECIFIC && new_pat->patgrp->folder) + free_pattern(&new_pat->patgrp->folder); + + /* set up the action */ + if(!(strcmp(rule, "filter"))) + new_pat->action->is_a_filter = 1; + else if(!(strcmp(rule, "role"))) + new_pat->action->is_a_role = 1; + else if(!(strcmp(rule, "score"))) + new_pat->action->is_a_score = 1; + else if(!(strcmp(rule, "indexcolor"))) + new_pat->action->is_a_incol = 1; + else{ + free_pat(&new_pat); + return(TCL_ERROR); + } + + for(i = 0; i < nAct; i++){ + Tcl_ListObjGetElements(interp, objAct[i], &nActEmnt, &objActEmnt); + if(nActEmnt !=2){ + free_pat(&new_pat); + return(TCL_ERROR); + } + + actvar = Tcl_GetStringFromObj(objActEmnt[0], NULL); + actval = Tcl_GetStringFromObj(objActEmnt[1], NULL); + if(!actvar || !actval){ + free_pat(&new_pat); + return(TCL_ERROR); + } + + if(new_pat->action->is_a_filter && !(strcmp(actvar, "action"))){ + if(!strcmp(actval, "delete")) + new_pat->action->kill = 1; + else if(!strcmp(actval, "move")) + new_pat->action->kill = 0; + else{ + free_pat(&new_pat); + return(TCL_ERROR); + } + } + else if(new_pat->action->is_a_filter && !(strcmp(actvar, "folder"))){ + tstr = cpystr(actval); + removing_leading_and_trailing_white_space(tstr); + if(!(*tstr)) fs_give((void **)&tstr); + new_pat->action->folder = string_to_pattern(tstr); + if(tstr) fs_give((void **)&tstr); + } + else if(new_pat->action->is_a_filter && !(strcmp(actvar, "moind"))){ + if(!strcmp(actval, "1")) + new_pat->action->move_only_if_not_deleted = 1; + else if(!strcmp(actval, "0")) + new_pat->action->move_only_if_not_deleted = 0; + else{ + free_pat(&new_pat); + return(TCL_ERROR); + } + } + else if(new_pat->action->is_a_incol && !(strcmp(actvar, "fg"))){ + char asciicolor[256]; + + if(ascii_colorstr(asciicolor, actval) == 0) { + if(!new_pat->action->incol){ + new_pat->action->incol = new_color_pair(asciicolor,NULL); + } + else + snprintf(new_pat->action->incol->fg, + sizeof(new_pat->action->incol->fg), "%s", asciicolor); + } + } + else if(new_pat->action->is_a_incol && !(strcmp(actvar, "bg"))){ + char asciicolor[256]; + + if(ascii_colorstr(asciicolor, actval) == 0) { + if(!new_pat->action->incol){ + new_pat->action->incol = new_color_pair(NULL, asciicolor); + } + else + snprintf(new_pat->action->incol->bg, + sizeof(new_pat->action->incol->bg), "%s", asciicolor); + } + } + else if(new_pat->action->is_a_score && !(strcmp(actvar, "scoreval"))){ + long scoreval = (long) atoi(actval); + + if(scoreval >= SCORE_MIN && scoreval <= SCORE_MAX) + new_pat->action->scoreval = scoreval; + } + else if(new_pat->action->is_a_score && !(strcmp(actvar, "scorehdr"))){ + HEADER_TOK_S *hdrtok; + + if((hdrtok = stringform_to_hdrtok(actval)) != NULL) + new_pat->action->scorevalhdrtok = hdrtok; + } + else{ + free_pat(&new_pat); + return(TCL_ERROR); + } + } + + if(new_pat->action->is_a_filter && new_pat->action->kill && new_pat->action->folder) + fs_give((void **)&new_pat->action->folder); + else if(new_pat->action->is_a_filter && new_pat->action->kill == 0 && new_pat->action->folder == 0){ + free_pat(&new_pat); + Tcl_SetResult(interp, "No folder set for Move", TCL_VOLATILE); + return(TCL_OK); + } + } + + if(aflags & RS_RULE_EDIT) + rv = edit_pattern(new_pat, rno, rflags); + else if(aflags & RS_RULE_ADD) + rv = add_pattern(new_pat, rflags); + else if(aflags & RS_RULE_DELETE) + rv = delete_pattern(rno, rflags); + else if(aflags & RS_RULE_SHUFFUP) + rv = shuffle_pattern(rno, 1, rflags); + else if(aflags & RS_RULE_SHUFFDOWN) + rv = shuffle_pattern(rno, -1, rflags); + else + rv = 1; + + return(rv ? TCL_ERROR : TCL_OK); +} + + +#if 0 +ADDRESS * +peAEToAddress(AdrBk_Entry *ae) +{ + char *list, *l1, *l2; + int length; + BuildTo bldto; + ADDRESS *addr = NULL; + + if(ae->tag == List){ + length = 0; + for(l2 = ae->addr.list; *l2; l2++) + length += (strlen(*l2) + 1); + + list = (char *) fs_get(length + 1); + list[0] = '\0'; + l1 = list; + for(l2 = ae->addr.list; *l2; l2++){ + if(l1 != list && l1-list < length+1) + *l1++ = ','; + + strncpy(l1, *l2, length+1-(l1-list)); + l1 += strlen(l1); + } + + list[length] = '\0'; + + bldto.type = Str; + bldto.arg.str = list; + adr2 = expand_address(bldto, userdomain, localdomain, + loop_detected, fcc, did_set, + lcc, error, 1, simple_verify, + mangled); + + fs_give((void **) &list); + } + else if(ae->tag == Single){ + if(strucmp(ae->addr.addr, a->mailbox)){ + bldto.type = Str; + bldto.arg.str = ae->addr.addr; + adr2 = expand_address(bldto, userdomain, + localdomain, loop_detected, + fcc, did_set, lcc, + error, 1, simple_verify, + mangled); + } + else{ + /* + * A loop within plain single entry is ignored. + * Set up so later code thinks we expanded. + */ + adr2 = mail_newaddr(); + adr2->mailbox = cpystr(ae->addr.addr); + adr2->host = cpystr(userdomain); + adr2->adl = cpystr(a->adl); + } + } + + /* + * Personal names: If the expanded address has a personal + * name and the address book entry is a list with a fullname, + * tack the full name from the address book on in front. + * This mainly occurs with a distribution list where the + * list has a full name, and the first person in the list also + * has a full name. + * + * This algorithm doesn't work very well if lists are + * included within lists, but it's not clear what would + * be better. + */ + if(ae->fullname && ae->fullname[0]){ + if(adr2->personal && adr2->personal[0]){ + if(ae->tag == List){ + /* combine list name and existing name */ + char *name; + + if(!simple_verify){ + size_t l; + l = strlen(adr2->personal) + strlen(ae->fullname) + 4; + name = (char *)fs_get((l+1) * sizeof(char)); + snprintf(name, l+1, "%s -- %s", ae->fullname, + adr2->personal); + fs_give((void **)&adr2->personal); + adr2->personal = name; + } + } + else{ + /* replace with nickname fullname */ + fs_give((void **)&adr2->personal); + adr2->personal = adrbk_formatname(ae->fullname, + NULL, NULL); + } + } + else{ + if(abe-p>tag != List || !simple_verify){ + if(adr2->personal) + fs_give((void **)&adr2->personal); + + adr2->personal = adrbk_formatname(abe->fullname, + NULL, NULL); + } + } + } + + return(addr); +} + + + +char * +peAEFcc(AdrBk_Entry *ae) +{ + char *fcc = NULL; + + if(ae->fcc && ae->fcc[0]){ + + if(!strcmp(ae->fcc, "\"\"")) + fcc = cpystr(""); + else + fcc = cpystr(ae->fcc); + + } + else if(ae->nickname && ae->nickname[0] && + (ps_global->fcc_rule == FCC_RULE_NICK || + ps_global->fcc_rule == FCC_RULE_NICK_RECIP)){ + /* + * else if fcc-rule=fcc-by-nickname, use that + */ + + fcc = cpystr(ae->nickname); + } + + return(fcc); +} +#endif + + +PINEFIELD * +peCustomHdrs(void) +{ + extern PINEFIELD *parse_custom_hdrs(char **, CustomType); + + return(parse_custom_hdrs(ps_global->VAR_CUSTOM_HDRS, UseAsDef)); +} + + + +/* + * PEClistCmd - Collection list editing tools + */ +int +PEClistCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *err = "Unknown PEClist request"; + + dprint((2, "PEClistCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + } + else{ + char *s1 = Tcl_GetStringFromObj(objv[1], NULL); + + if(s1){ + if(objc == 3){ /* delete */ + if(!strcmp(s1, "delete")){ + int cl, i, n, deln; + char **newl; + CONTEXT_S *del_ctxt, *tmp_ctxt, *new_ctxt; + + if(Tcl_GetIntFromObj(interp, objv[2], &cl) == TCL_ERROR){ + Tcl_SetResult(interp, + "cledit malformed: first arg must be int", + TCL_VOLATILE); + return(TCL_ERROR); + } + for(i = 0, del_ctxt = ps_global->context_list; + del_ctxt && i < cl; i++, del_ctxt = del_ctxt->next); + if(!del_ctxt) return(TCL_ERROR); + for(n = 0; del_ctxt->var.v->current_val.l[n]; n++); + n--; + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + deln = del_ctxt->var.i; + for(i = 0; del_ctxt->var.v->current_val.l[i]; i++){ + if(i < deln) + newl[i] = cpystr(del_ctxt->var.v->current_val.l[i]); + else if(i > deln) + newl[i-1] = cpystr(del_ctxt->var.v->current_val.l[i]); + } + n = set_variable_list(del_ctxt->var.v - ps_global->vars, + *newl ? newl : NULL, TRUE, Main); + free_list_array(&newl); + set_current_val(del_ctxt->var.v, TRUE, FALSE); + if(n){ + Tcl_SetResult(interp, + "Error saving changes", + TCL_VOLATILE); + return TCL_OK; + } + for(tmp_ctxt = del_ctxt->next; tmp_ctxt && tmp_ctxt->var.v == + del_ctxt->var.v; tmp_ctxt = tmp_ctxt->next) + tmp_ctxt->var.i--; + if((tmp_ctxt = del_ctxt->next) != NULL) + tmp_ctxt->prev = del_ctxt->prev; + if((tmp_ctxt = del_ctxt->prev) != NULL) + tmp_ctxt->next= del_ctxt->next; + if(!del_ctxt->prev && !del_ctxt->next){ + new_ctxt = new_context(del_ctxt->var.v->current_val.l[0], NULL); + ps_global->context_list = new_ctxt; + if(!new_ctxt->var.v) + new_ctxt->var = del_ctxt->var; + } + else if(ps_global->context_list == del_ctxt){ + ps_global->context_list = del_ctxt->next; + if(!ps_global->context_list) + return TCL_ERROR; /* this shouldn't happen */ + } + if(ps_global->context_last == del_ctxt) + ps_global->context_last = NULL; + if(ps_global->context_current == del_ctxt){ + strncpy(ps_global->cur_folder, + ps_global->mail_stream->mailbox, + sizeof(ps_global->cur_folder)); + ps_global->cur_folder[sizeof(ps_global->cur_folder)-1] = '\0'; + ps_global->context_current = ps_global->context_list; + } + del_ctxt->prev = NULL; + del_ctxt->next = NULL; + free_context(&del_ctxt); + init_inbox_mapping(ps_global->VAR_INBOX_PATH, + ps_global->context_list); + return TCL_OK; + } + else if(!strcmp(s1, "shuffdown")){ + int cl, i, shn, n; + CONTEXT_S *sh_ctxt, *nsh_ctxt, *tctxt; + char **newl, *tmpch; + + if(Tcl_GetIntFromObj(interp, objv[2], &cl) == TCL_ERROR){ + Tcl_SetResult(interp, + "cledit malformed: first arg must be int", + TCL_VOLATILE); + return(TCL_ERROR); + } + for(sh_ctxt = ps_global->context_list, i = 0; + sh_ctxt && i < cl ; i++, sh_ctxt = sh_ctxt->next); + if(!sh_ctxt || !sh_ctxt->next){ + Tcl_SetResult(interp, + "invalid context list number", + TCL_VOLATILE); + return TCL_ERROR; + } + if(sh_ctxt->var.v == sh_ctxt->next->var.v){ + shn = sh_ctxt->var.i; + for(n = 0; sh_ctxt->var.v->current_val.l[n]; n++); + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + for(i = 0; sh_ctxt->var.v->current_val.l[i]; i++){ + if(i == shn) + newl[i] = cpystr(sh_ctxt->var.v->current_val.l[i+1]); + else if(i == shn + 1) + newl[i] = cpystr(sh_ctxt->var.v->current_val.l[i-1]); + else + newl[i] = cpystr(sh_ctxt->var.v->current_val.l[i]); + } + n = set_variable_list(sh_ctxt->var.v - ps_global->vars, + newl, TRUE, Main); + free_list_array(&newl); + set_current_val(sh_ctxt->var.v, TRUE, FALSE); + if(n){ + Tcl_SetResult(interp, + "Error saving changes", + TCL_VOLATILE); + return TCL_OK; + } + nsh_ctxt = sh_ctxt->next; + nsh_ctxt->var.i--; + sh_ctxt->var.i++; + } + else{ + nsh_ctxt = sh_ctxt->next; + shn = sh_ctxt->var.i; + tmpch = cpystr(sh_ctxt->var.v->current_val.l[shn]); + for(n = 0; sh_ctxt->var.v->current_val.l[n]; n++); + n--; + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + for(i = 0; sh_ctxt->var.v->current_val.l[i+1]; i++) + newl[i] = cpystr(sh_ctxt->var.v->current_val.l[i]); + n = set_variable_list(sh_ctxt->var.v - ps_global->vars, + newl, FALSE, Main); + free_list_array(&newl); + set_current_val(sh_ctxt->var.v, TRUE, FALSE); + for(n = 0; nsh_ctxt->var.v->current_val.l[n]; n++); + n++; + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + newl[0] = cpystr(nsh_ctxt->var.v->current_val.l[0]); + newl[1] = tmpch; + for(i = 2; nsh_ctxt->var.v->current_val.l[i-1]; i++) + newl[i] = cpystr(nsh_ctxt->var.v->current_val.l[i-1]); + n = set_variable_list(nsh_ctxt->var.v - ps_global->vars, + newl, TRUE, Main); + free_list_array(&newl); + set_current_val(nsh_ctxt->var.v, TRUE, FALSE); + sh_ctxt->var.v = nsh_ctxt->var.v; + sh_ctxt->var.i = 1; + /* this for loop assumes that there are only two variable lists, + * folder-collections and news-collections, a little more will + * have to be done if we want to accomodate for the INHERIT + * option introduced in 4.30. + */ + for(tctxt = nsh_ctxt->next; tctxt; tctxt = tctxt->next) + tctxt->var.i++; + } + if(sh_ctxt->prev) sh_ctxt->prev->next = nsh_ctxt; + nsh_ctxt->prev = sh_ctxt->prev; + sh_ctxt->next = nsh_ctxt->next; + nsh_ctxt->next = sh_ctxt; + sh_ctxt->prev = nsh_ctxt; + if(sh_ctxt->next) sh_ctxt->next->prev = sh_ctxt; + if(ps_global->context_list == sh_ctxt) + ps_global->context_list = nsh_ctxt; + init_inbox_mapping(ps_global->VAR_INBOX_PATH, + ps_global->context_list); + return TCL_OK; + } + else if(!strcmp(s1, "shuffup")){ + int cl, i, shn, n; + CONTEXT_S *sh_ctxt, *psh_ctxt, *tctxt; + char **newl, *tmpch; + + if(Tcl_GetIntFromObj(interp, objv[2], &cl) == TCL_ERROR){ + Tcl_SetResult(interp, + "cledit malformed: first arg must be int", + TCL_VOLATILE); + return(TCL_ERROR); + } + for(sh_ctxt = ps_global->context_list, i = 0; + sh_ctxt && i < cl ; i++, sh_ctxt = sh_ctxt->next); + if(!sh_ctxt || !sh_ctxt->prev){ + Tcl_SetResult(interp, + "invalid context list number", + TCL_VOLATILE); + return TCL_ERROR; + } + if(sh_ctxt->var.v == sh_ctxt->prev->var.v){ + shn = sh_ctxt->var.i; + for(n = 0; sh_ctxt->var.v->current_val.l[n]; n++); + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + for(i = 0; sh_ctxt->var.v->current_val.l[i]; i++){ + if(i == shn) + newl[i] = cpystr(sh_ctxt->var.v->current_val.l[i-1]); + else if(i == shn - 1) + newl[i] = cpystr(sh_ctxt->var.v->current_val.l[i+1]); + else + newl[i] = cpystr(sh_ctxt->var.v->current_val.l[i]); + } + i = set_variable_list(sh_ctxt->var.v - ps_global->vars, + newl, TRUE, Main); + free_list_array(&newl); + set_current_val(sh_ctxt->var.v, TRUE, FALSE); + if(i){ + Tcl_SetResult(interp, + "Error saving changes", + TCL_VOLATILE); + return TCL_OK; + } + psh_ctxt = sh_ctxt->prev; + psh_ctxt->var.i++; + sh_ctxt->var.i--; + } + else{ + psh_ctxt = sh_ctxt->prev; + shn = sh_ctxt->var.i; + tmpch = cpystr(sh_ctxt->var.v->current_val.l[shn]); + for(n = 0; sh_ctxt->var.v->current_val.l[n]; n++); + n--; + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + for(i = 1; sh_ctxt->var.v->current_val.l[i]; i++) + newl[i-1] = cpystr(sh_ctxt->var.v->current_val.l[i]); + i = set_variable_list(sh_ctxt->var.v - ps_global->vars, + newl, FALSE, Main); + free_list_array(&newl); + if(i){ + Tcl_SetResult(interp, + "Error saving changes", + TCL_VOLATILE); + return TCL_OK; + } + set_current_val(sh_ctxt->var.v, TRUE, FALSE); + for(n = 0; psh_ctxt->var.v->current_val.l[n]; n++); + n++; + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + for(i = 0; psh_ctxt->var.v->current_val.l[i+1]; i++) + newl[i] = cpystr(psh_ctxt->var.v->current_val.l[i]); + newl[i++] = tmpch; + newl[i] = cpystr(psh_ctxt->var.v->current_val.l[i-1]); + i = set_variable_list(psh_ctxt->var.v - ps_global->vars, + newl, TRUE, Main); + free_list_array(&newl); + if(i){ + Tcl_SetResult(interp, + "Error saving changes", + TCL_VOLATILE); + return TCL_OK; + } + set_current_val(psh_ctxt->var.v, TRUE, FALSE); + for(tctxt = sh_ctxt->next ; tctxt; tctxt = tctxt->next) + tctxt->var.i--; + sh_ctxt->var.v = psh_ctxt->var.v; + sh_ctxt->var.i = n - 2; + /* There MUST be at least 2 collections in the list */ + psh_ctxt->var.i++; + } + if(sh_ctxt->next) sh_ctxt->next->prev = psh_ctxt; + psh_ctxt->next = sh_ctxt->next; + sh_ctxt->prev = psh_ctxt->prev; + psh_ctxt->prev = sh_ctxt; + sh_ctxt->next = psh_ctxt; + if(sh_ctxt->prev) sh_ctxt->prev->next = sh_ctxt; + if(ps_global->context_list == psh_ctxt) + ps_global->context_list = sh_ctxt; + init_inbox_mapping(ps_global->VAR_INBOX_PATH, + ps_global->context_list); + return TCL_OK; + } + } + else if(objc == 7){ + if(!strcmp(s1, "edit") || !strcmp(s1, "add")){ + int cl, quotes_needed = 0, i, add = 0, n = 0; + char *nick, *server, *path, *view, + context_buf[MAILTMPLEN*4], **newl; + CONTEXT_S *new_ctxt, *tmp_ctxt; + + if(!strcmp(s1, "add")) add = 1; + + if(Tcl_GetIntFromObj(interp, objv[2], &cl) == TCL_ERROR){ + Tcl_SetResult(interp, + "cledit malformed: first arg must be int", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(!(nick = Tcl_GetStringFromObj(objv[3], NULL))){ + Tcl_SetResult(interp, + "Error1", + TCL_VOLATILE); + return TCL_ERROR; + } + if(!(server = Tcl_GetStringFromObj(objv[4], NULL))){ + Tcl_SetResult(interp, + "Error2", + TCL_VOLATILE); + return TCL_ERROR; + } + if(!(path = Tcl_GetStringFromObj(objv[5], NULL))){ + Tcl_SetResult(interp, + "Error3", + TCL_VOLATILE); + return TCL_ERROR; + } + if(!(view = Tcl_GetStringFromObj(objv[6], NULL))){ + Tcl_SetResult(interp, + "Error4", + TCL_VOLATILE); + return TCL_ERROR; + } + removing_leading_and_trailing_white_space(nick); + removing_leading_and_trailing_white_space(server); + removing_leading_and_trailing_white_space(path); + removing_leading_and_trailing_white_space(view); + if(strchr(nick, ' ')) + quotes_needed = 1; + if(strlen(nick)+strlen(server)+strlen(path)+strlen(view) > + MAILTMPLEN * 4 - 20) { /* for good measure */ + Tcl_SetResult(interp, + "info too long", + TCL_VOLATILE); + + return TCL_ERROR; + } + if(3 + strlen(nick) + strlen(server) + strlen(path) + + strlen(view) > MAILTMPLEN + 4){ + Tcl_SetResult(interp, + "collection fields too long", + TCL_VOLATILE); + return(TCL_OK); + } + snprintf(context_buf, sizeof(context_buf), "%s%s%s%s%s%s[%s]", quotes_needed ? + "\"" : "", nick, quotes_needed ? "\"" : "", + strlen(nick) ? " " : "", + server, path, view); + new_ctxt = new_context(context_buf, NULL); + if(!add){ + for(tmp_ctxt = ps_global->context_list, i = 0; + tmp_ctxt && i < cl; i++, tmp_ctxt = tmp_ctxt->next); + if(!tmp_ctxt){ + Tcl_SetResult(interp, + "invalid context list number", + TCL_VOLATILE); + return TCL_ERROR; + } + new_ctxt->next = tmp_ctxt->next; + new_ctxt->prev = tmp_ctxt->prev; + if(tmp_ctxt->prev && tmp_ctxt->prev->next == tmp_ctxt) + tmp_ctxt->prev->next = new_ctxt; + if(tmp_ctxt->next && tmp_ctxt->next->prev == tmp_ctxt) + tmp_ctxt->next->prev = new_ctxt; + if(ps_global->context_list == tmp_ctxt) + ps_global->context_list = new_ctxt; + if(ps_global->context_current == tmp_ctxt){ + strncpy(ps_global->cur_folder, + ps_global->mail_stream->mailbox, + sizeof(ps_global->cur_folder)); + ps_global->cur_folder[sizeof(ps_global->cur_folder)-1] = '\0'; + ps_global->context_current = new_ctxt; + } + if(ps_global->context_last == tmp_ctxt) + ps_global->context_last = new_ctxt; + new_ctxt->var = tmp_ctxt->var; + tmp_ctxt->next = tmp_ctxt->prev = NULL; + free_context(&tmp_ctxt); + } + else { + for(tmp_ctxt = ps_global->context_list; + tmp_ctxt->next; tmp_ctxt = tmp_ctxt->next); + new_ctxt->prev = tmp_ctxt; + tmp_ctxt->next = new_ctxt; + new_ctxt->var.v = tmp_ctxt->var.v; + new_ctxt->var.i = tmp_ctxt->var.i + 1; + } + if(!new_ctxt->var.v){ + Tcl_SetResult(interp, + "Error5", + TCL_VOLATILE); + return TCL_ERROR; + } + for(n = 0; new_ctxt->var.v->current_val.l[n]; n++); + if(add) n++; + newl = (char **) fs_get((n + 1) * sizeof(char *)); + newl[n] = NULL; + for(n = 0; new_ctxt->var.v->current_val.l[n]; n++) + newl[n] = (n == new_ctxt->var.i) + ? cpystr(context_buf) + : cpystr(new_ctxt->var.v->current_val.l[n]); + if(add) newl[n++] = cpystr(context_buf); + n = set_variable_list(new_ctxt->var.v - ps_global->vars, + newl, TRUE, Main); + free_list_array(&newl); + set_current_val(new_ctxt->var.v, TRUE, FALSE); + init_inbox_mapping(ps_global->VAR_INBOX_PATH, + ps_global->context_list); + if(n){ + Tcl_SetResult(interp, + "Error saving changes", + TCL_VOLATILE); + return TCL_OK; + } + return TCL_OK; + + } + } + } + } + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + +/* + * peTakeaddr - Take Address + */ +int +peTakeaddr(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + TA_S *talist = NULL, *current, *head; + Tcl_Obj *itemObj, *secObj = NULL, *resObj = NULL; + int anum = 0; + + mn_set_cur(sp_msgmap(ps_global->mail_stream), peMessageNumber(uid)); + + if(set_up_takeaddr('a', ps_global, sp_msgmap(ps_global->mail_stream), + &talist, &anum, TA_NOPROMPT, NULL) < 0 + || (talist == NULL)){ + Tcl_SetResult(interp, + "Take address failed to set up", + TCL_VOLATILE); + return(TCL_ERROR); + } + + for(head = talist ; head->prev; head = head->prev); + /* + * Return value will be of the form: + * { + * { "line to print", + * {"personal", "mailbox", "host"} # addr + * {"nick", "fullname", "fcc", "comment"} # suggested + * } + * ... + * } + * + * The two list items will be empty if that line is + * just informational. + */ + itemObj = Tcl_NewListObj(0, NULL); + for(current = head; current ; current = current->next){ + if(current->skip_it && !current->print) continue; + secObj = Tcl_NewListObj(0, NULL); + if(Tcl_ListObjAppendElement(interp, secObj, + Tcl_NewStringObj(current->strvalue,-1)) != TCL_OK) + return(TCL_ERROR); + resObj = Tcl_NewListObj(0, NULL); + /* append the address information */ + if(current->addr && !current->print){ + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(current->addr->personal + ? current->addr->personal + : "", -1)) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(current->addr->mailbox + ? current->addr->mailbox + : "", -1)) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(current->addr->host + ? current->addr->host + : "", -1)) != TCL_OK) + return(TCL_ERROR); + } + if(Tcl_ListObjAppendElement(interp, secObj, + resObj) != TCL_OK) + return(TCL_ERROR); + resObj = Tcl_NewListObj(0, NULL); + /* append the suggested possible entries */ + if(!current->print + && (current->nickname || current->fullname + || current->fcc || current->comment)){ + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(current->nickname + ? current->nickname + : "", -1)) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(current->fullname + ? current->fullname + : "", -1)) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(current->fcc + ? current->fcc + : "", -1)) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(current->comment + ? current->comment + : "", -1)) != TCL_OK) + return(TCL_ERROR); + } + if(Tcl_ListObjAppendElement(interp, secObj, resObj) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + secObj) != TCL_OK) + return(TCL_ERROR); + } + + free_talines(&talist); + return(TCL_OK); +} + + +/* + * peTakeFrom - Take only From Address + */ +int +peTakeFrom(Tcl_Interp *interp, imapuid_t uid, int objc, Tcl_Obj **objv) +{ + char *err = NULL; + Tcl_Obj *objItem; + ADDRESS *ap; + ENVELOPE *env; + long rawno; + + /* + * Return value will be of the form: + * { + * { "line to print", + * {"personal", "mailbox", "host"} # addr + * {"nick", "fullname", "fcc", "comment"} # suggested + * } + * ... + * } + * + * The two list items will be empty if that line is + * just informational. + */ + + if(uid){ + if((env = pine_mail_fetchstructure(ps_global->mail_stream, + rawno = peSequenceNumber(uid), + NULL))){ + /* append the address information */ + for(ap = env->from; ap; ap = ap->next){ + objItem = Tcl_NewListObj(0, NULL); + /* append EMPTY "line to print" */ + if(Tcl_ListObjAppendElement(interp, objItem, Tcl_NewStringObj("",-1)) != TCL_OK) + return(TCL_ERROR); + + /* append address info */ + peAppListF(interp, objItem, "%s%s%s", + ap->personal ? (char *) rfc1522_decode_to_utf8((unsigned char *) tmp_20k_buf, SIZEOF_20KBUF, ap->personal) : "", + ap->mailbox ? ap->mailbox : "", + ap->host ? ap->host : ""); + + /* append suggested info */ + peAddSuggestedContactInfo(interp, objItem, ap); + + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), objItem) != TCL_OK) + return(TCL_ERROR); + } + + return(TCL_OK); + } + else + err = ps_global->last_error; + } + else + err = "Invalid UID"; + + return(TCL_ERROR); +} + + +int +peAddSuggestedContactInfo(Tcl_Interp *interp, Tcl_Obj *lobjp, ADDRESS *addr) +{ + char *nick = NULL, *full = NULL, *fcc = NULL, *comment = NULL; + + get_contactinfo_from_addr(addr, &nick, &full, &fcc, &comment); + + peAppListF(interp, lobjp, "%s%s%s%s", + nick ? nick : "", + full ? full : "", + fcc ? fcc : "", + comment ? comment : ""); + + if(nick) + fs_give((void **) &nick); + + if(full) + fs_give((void **) &full); + + if(fcc) + fs_give((void **) &fcc); + + if(comment) + fs_give((void **) &comment); +} + + +/* * * * * * * * * Status message ring management * * * * * * * * * * * * */ + +STATMSG_S * +sml_newmsg(int priority, char *text) +{ + static long id = 1; + STATMSG_S *smp; + + smp = (STATMSG_S *) fs_get(sizeof(STATMSG_S)); + memset(smp, 0, sizeof(STATMSG_S)); + smp->id = id++; + smp->posted = time(0); + smp->type = priority; + smp->text = cpystr(text); + return(smp); +} + + +void +sml_addmsg(int priority, char *text) +{ + STATMSG_S *smp = sml_newmsg(priority, text); + + if(peStatList){ + smp->next = peStatList; + peStatList = smp; + } + else + peStatList = smp; +} + + +char ** +sml_getmsgs(void) +{ + int n; + STATMSG_S *smp; + char **retstrs = NULL, **tmpstrs; + + for(n = 0, smp = peStatList; smp && !smp->seen; n++, smp = smp->next) + ; + + if(n == 0) return NULL; + retstrs = (char **)fs_get((n+1)*sizeof(char *)); + for(tmpstrs = retstrs, smp = peStatList; smp && !smp->seen; smp = smp->next){ + *tmpstrs = smp->text; + tmpstrs++; + } + + *tmpstrs = NULL; + return(retstrs); +} + + +char * +sml_getmsg(void) +{ + return(peStatList ? peStatList->text : ""); +} + +void +sml_seen(void) +{ + STATMSG_S *smp; + + for(smp = peStatList; smp; smp = smp->next) + smp->seen = 1; +} + + + +/* * * * * * * * * LDAP Support Routines * * * * * * * * * * * */ + + +/* + * PELdapCmd - LDAP TCL interface + */ +int +PELdapCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ +#ifndef ENABLE_LDAP + char *err = "Call to PELdap when LDAP not enabled"; +#else + char *err = "Unknown PELdap request"; + char *s1; + + dprint((2, "PELdapCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); + } + s1 = Tcl_GetStringFromObj(objv[1], NULL); + + if(s1){ + int qn; + if(!strcmp(s1, "directories")){ + int i; + LDAP_SERV_S *info; + Tcl_Obj *secObj; + + if(objc != 2){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); + } + if(ps_global->VAR_LDAP_SERVERS){ + for(i = 0; ps_global->VAR_LDAP_SERVERS[i] && + ps_global->VAR_LDAP_SERVERS[i][0]; i++){ + info = break_up_ldap_server(ps_global->VAR_LDAP_SERVERS[i]); + secObj = Tcl_NewListObj(0, NULL); + if(Tcl_ListObjAppendElement(interp, secObj, + Tcl_NewStringObj(info->nick ? info->nick + : "", -1)) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, secObj, + Tcl_NewStringObj(info->serv ? info->serv + : "", -1)) != TCL_OK) + return(TCL_ERROR); + + if(info) + free_ldap_server_info(&info); + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + secObj) != TCL_OK) + return(TCL_ERROR); + } + } + else + Tcl_SetResult(interp, "", TCL_STATIC); + + return(TCL_OK); + } + else if(!strcmp(s1, "query")){ + int dir; + char *srchstr, *filtstr; + LDAP_CHOOSE_S *winning_e = NULL; + LDAP_SERV_RES_S *results = NULL; + WP_ERR_S wp_err; + CUSTOM_FILT_S *filter = NULL; + + if(objc != 5){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); + } + if(Tcl_GetIntFromObj(interp, objv[2], &dir) == TCL_ERROR){ + Tcl_SetResult(interp, + "PELdap results malformed: first arg must be int", + TCL_VOLATILE); + return(TCL_ERROR); + } + wpldap_global->query_no++; + if(wpldap_global->ldap_search_list){ + wpldap_global->ldap_search_list = + free_wpldapres(wpldap_global->ldap_search_list); + } + srchstr = Tcl_GetStringFromObj(objv[3], NULL); + filtstr = Tcl_GetStringFromObj(objv[4], NULL); + if(!srchstr) return(TCL_ERROR); + if(!filtstr) return(TCL_ERROR); + if(*filtstr){ + filter = (CUSTOM_FILT_S *)fs_get(sizeof(CUSTOM_FILT_S)); + filter->filt = cpystr(filtstr); + filter->combine = 0; + } + memset(&wp_err, 0, sizeof(wp_err)); + ldap_lookup_all(srchstr, dir, 0, AlwaysDisplay, filter, &winning_e, + &wp_err, &results); + if(filter){ + fs_give((void **)&filter->filt); + fs_give((void **)&filter); + } + Tcl_SetResult(interp, int2string(wpldap_global->ldap_search_list + ? wpldap_global->query_no : 0), + TCL_VOLATILE); + return(TCL_OK); + } + /* + * First argument has always got to be the query number for now. + * Might need to rething that when setting up queries. + */ + if(objc == 2){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); + } + if(Tcl_GetIntFromObj(interp, objv[2], &qn) == TCL_ERROR){ + Tcl_SetResult(interp, + "PELdap results malformed: first arg must be int", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(qn != wpldap_global->query_no){ + Tcl_SetResult(interp, + "Query is no longer valid", TCL_VOLATILE); + return(TCL_ERROR); + } + if(objc == 3){ + if(!strcmp(s1, "results")){ + return(peLdapQueryResults(interp)); + } + } + else if(objc == 4){ + if(!strcmp(s1, "ldapext")){ + /* + * Returns a list of the form: + * {"dn" {{attrib {val, ...}}, ...}} + */ + char *whichrec = Tcl_GetStringFromObj(objv[3], NULL); + char *tmpstr, *tmp, *tmp2, **vals, *a; + WPLDAPRES_S *curres; + LDAP_CHOOSE_S *winning_e = NULL; + LDAP_SERV_RES_S *trl; + Tcl_Obj *secObj = NULL, *resObj = NULL, *itemObj; + BerElement *ber; + LDAPMessage *e; + int i, j, whichi, whichj; + + if(whichrec == NULL){ + Tcl_SetResult(interp, "Ldap ldapext error 1", TCL_VOLATILE); + return TCL_ERROR; + } + tmpstr = cpystr(whichrec); + tmp = tmpstr; + for(tmp2 = tmp; *tmp2 >= '0' && *tmp2 <= '9'; tmp2++); + if(*tmp2 != '.'){ + Tcl_SetResult(interp, "Ldap ldapext error 2", TCL_VOLATILE); + return TCL_ERROR; + } + *tmp2 = '\0'; + whichi = atoi(tmp); + *tmp2 = '.'; + tmp2++; + for(tmp = tmp2; *tmp2 >= '0' && *tmp2 <= '9'; tmp2++); + if(*tmp2 != '\0'){ + Tcl_SetResult(interp, "Ldap ldapext error 3", TCL_VOLATILE); + return TCL_ERROR; + } + whichj = atoi(tmp); + fs_give((void **)&tmpstr); + for(curres = wpldap_global->ldap_search_list, i = 0; + i < whichi && curres; i++, curres = curres->next); + if(!curres){ + Tcl_SetResult(interp, "Ldap ldapext error 4", TCL_VOLATILE); + return TCL_ERROR; + } + for(trl = curres->reslist, j = 0; trl; trl = trl->next){ + for(e = ldap_first_entry(trl->ld, trl->res); + e != NULL && j < whichj; + e = ldap_next_entry(trl->ld, e), j++); + if(e != NULL && j == whichj) + break; + } + if(e == NULL || trl == NULL){ + Tcl_SetResult(interp, "Ldap ldapext error 5", TCL_VOLATILE); + return TCL_ERROR; + } + winning_e = (LDAP_CHOOSE_S *)fs_get(sizeof(LDAP_CHOOSE_S)); + winning_e->ld = trl->ld; + winning_e->selected_entry = e; + winning_e->info_used = trl->info_used; + winning_e->serv = trl->serv; + a = ldap_get_dn(winning_e->ld, winning_e->selected_entry); + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + Tcl_NewStringObj(a ? a : "", -1)) != TCL_OK) + return(TCL_ERROR); + if(a) + our_ldap_dn_memfree(a); + + itemObj = Tcl_NewListObj(0, NULL); + for(a = ldap_first_attribute(winning_e->ld, winning_e->selected_entry, &ber); + a != NULL; + a = ldap_next_attribute(winning_e->ld, winning_e->selected_entry, ber)){ + if(a && *a){ + secObj = Tcl_NewListObj(0, NULL); + if(Tcl_ListObjAppendElement(interp, secObj, + Tcl_NewStringObj(ldap_translate(a, + winning_e->info_used), -1)) != TCL_OK) + return(TCL_ERROR); + resObj = Tcl_NewListObj(0, NULL); + vals = ldap_get_values(winning_e->ld, winning_e->selected_entry, a); + if(vals){ + for(i = 0; vals[i]; i++){ + if(Tcl_ListObjAppendElement(interp, resObj, + Tcl_NewStringObj(vals[i], -1)) != TCL_OK) + return(TCL_ERROR); + } + ldap_value_free(vals); + if(Tcl_ListObjAppendElement(interp, secObj, resObj) != TCL_OK) + return(TCL_ERROR); + } + if(!strcmp(a,"objectclass")){ + if(Tcl_ListObjAppendElement(interp, secObj, + Tcl_NewStringObj("objectclass", -1)) != TCL_OK) + return(TCL_ERROR); + } + if(Tcl_ListObjAppendElement(interp, itemObj, secObj) != TCL_OK) + return(TCL_ERROR); + } + our_ldap_memfree(a); + } + + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + itemObj) != TCL_OK) + return(TCL_ERROR); + + fs_give((void **)&winning_e); + return(TCL_OK); + } + } + else if(objc == 6){ + if(!strcmp(s1, "setaddrs")){ + char *listset = Tcl_GetStringFromObj(objv[3], NULL); + char *addrstr = Tcl_GetStringFromObj(objv[4], NULL); + char *tmp, *tmp2, *tmplistset, was_char, *ret_to, + *tmpaddrstr; + int **lset, noreplace = 0; + ADDRESS *adr = NULL, *curadr, *prevadr, *newadr, + *curnewadr, *newadrs; + int curi, i, j, numsrchs, numset, setit; + LDAP_CHOOSE_S *tres; + LDAP_SERV_RES_S *trl; + WPLDAPRES_S *curres; + LDAPMessage *e; + RFC822BUFFER rbuf; + size_t len; + + if(Tcl_GetIntFromObj(interp, objv[5], &noreplace) == TCL_ERROR){ + Tcl_SetResult(interp, + "PELdap results malformed: first arg must be int", + TCL_VOLATILE); + return(TCL_ERROR); + } + if(listset == NULL || addrstr == NULL) return TCL_ERROR; + tmpaddrstr = cpystr(addrstr); + + if(!noreplace){ + mail_parameters(NIL, SET_PARSEPHRASE, (void *)massage_phrase_addr); + rfc822_parse_adrlist(&adr, tmpaddrstr, "@"); + mail_parameters(NIL, SET_PARSEPHRASE, NULL); + } + + tmplistset = cpystr(listset); + for(curres = wpldap_global->ldap_search_list, numsrchs = 0; + curres; curres = curres->next, numsrchs++); + lset = (int **)fs_get((numsrchs+1)*sizeof(int *)); + for(i = 0; i < numsrchs; i++){ + for(tmp = tmplistset, numset = 0; *tmp;){ + for(tmp2 = tmp; *tmp2 >= '0' && *tmp2 <= '9'; tmp2++); + if(*tmp2 != '.'){ + Tcl_SetResult(interp, "Ldap error 1", TCL_VOLATILE); + return TCL_ERROR; + } + if(atoi(tmp) == i) numset++; + tmp2++; + for(tmp = tmp2; *tmp2 >= '0' && *tmp2 <= '9'; tmp2++); + if(*tmp2 != ',' && *tmp2 != '\0'){ + Tcl_SetResult(interp, "Ldap error 2", TCL_VOLATILE); + return TCL_ERROR; + } + if(*tmp2) tmp2++; + tmp = tmp2; + } + lset[i] = (int *)fs_get((numset+1)*sizeof(int)); + for(tmp = tmplistset, j = 0; *tmp && j < numset;){ + setit = 0; + for(tmp2 = tmp; *tmp2 >= '0' && *tmp2 <= '9'; tmp2++); + if(*tmp2 != '.'){ + Tcl_SetResult(interp, "Ldap error 3", TCL_VOLATILE); + return TCL_ERROR; + } + *tmp2 = '\0'; + if(atoi(tmp) == i) setit++; + *tmp2 = '.'; + tmp2++; + for(tmp = tmp2; *tmp2 >= '0' && *tmp2 <= '9'; tmp2++); + if(*tmp2 != ',' && *tmp2 != '\0'){ + Tcl_SetResult(interp, "Ldap error 4", TCL_VOLATILE); + return TCL_ERROR; + } + if(setit){ + was_char = *tmp2; + *tmp2 = '\0'; + lset[i][j++] = atoi(tmp); + *tmp2 = was_char; + } + if(*tmp2) tmp2++; + tmp = tmp2; + } + lset[i][j] = -1; + } + lset[i] = NULL; + for(i = 0, curres = wpldap_global->ldap_search_list; + i < numsrchs && curres; i++, curres = curres->next){ + prevadr = NULL; + for(curadr = adr; curadr; curadr = curadr->next){ + if(strcmp(curadr->mailbox, curres->str) == 0 + && curadr->host && *curadr->host == '@') + break; + prevadr = curadr; + } + if(!curadr && !noreplace){ + Tcl_SetResult(interp, "Ldap error 5", TCL_VOLATILE); + return TCL_ERROR; + } + newadrs = newadr = curnewadr = NULL; + for(trl = curres->reslist, j = 0, curi = 0; trl; trl = trl->next){ + for(e = ldap_first_entry(trl->ld, trl->res); + e != NULL && lset[i][curi] != -1; + e = ldap_next_entry(trl->ld, e), j++){ + if(j == lset[i][curi]){ + tres = (LDAP_CHOOSE_S *)fs_get(sizeof(LDAP_CHOOSE_S)); + tres->ld = trl->ld; + tres->selected_entry = e; + tres->info_used = trl->info_used; + tres->serv = trl->serv; + newadr = address_from_ldap(tres); + fs_give((void **)&tres); + + if(newadrs == NULL){ + newadrs = curnewadr = newadr; + } + else { + curnewadr->next = newadr; + curnewadr = newadr; + } + curi++; + } + } + } + if(newadrs == NULL || curnewadr == NULL){ + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "No Result Selected for \"%s\"", curadr->mailbox ? curadr->mailbox : "noname"); + q_status_message(SM_ORDER, 0, 3, tmp_20k_buf); + newadr = copyaddr(curadr); + if(newadrs == NULL){ + newadrs = curnewadr = newadr; + } + else { + curnewadr->next = newadr; + curnewadr = newadr; + } + } + curnewadr->next = curadr ? curadr->next : NULL; + if(curadr) curadr->next = NULL; + if(curadr == adr) + adr = newadrs; + else{ + prevadr->next = newadrs; + if(curadr) + mail_free_address(&curadr); + } + } + + len = est_size(adr); + ret_to = (char *)fs_get(len * sizeof(char)); + ret_to[0] = '\0'; + strip_personal_quotes(adr); + rbuf.f = dummy_soutr; + rbuf.s = NULL; + rbuf.beg = ret_to; + rbuf.cur = ret_to; + rbuf.end = ret_to+len-1; + rfc822_output_address_list(&rbuf, adr, 0L, NULL); + *rbuf.cur = '\0'; + Tcl_SetResult(interp, ret_to, TCL_VOLATILE); + fs_give((void **)&ret_to); + fs_give((void **)&tmpaddrstr); + fs_give((void **)&tmplistset); + for(i = 0; lset[i]; i++) + fs_give((void **)&lset[i]); + fs_give((void **)&lset); + if(adr) + mail_free_address(&adr); + + return(TCL_OK); + } + } + } +#endif /* ENABLE_LDAP */ + Tcl_SetResult(interp, err, TCL_STATIC); + return(TCL_ERROR); +} + + +#ifdef ENABLE_LDAP +int +peLdapQueryResults(Tcl_Interp *interp) +{ + WPLDAPRES_S *tsl; + Tcl_Obj *secObj = NULL, *resObj = NULL, *itemObj; + LDAPMessage *e; + LDAP_SERV_RES_S *trl; + /* returned list will be of the form: + * + * { + * {search-string + * {name, {title, ...}, {unit, ...}, + * {org, ...}, {email, ...}}, + * ... + * }, + * ... + * } + */ + + for(tsl = wpldap_global->ldap_search_list; + tsl; tsl = tsl->next){ + secObj = Tcl_NewListObj(0, NULL); + if(Tcl_ListObjAppendElement(interp, secObj, + Tcl_NewStringObj(tsl->str ? tsl->str + : "", -1)) != TCL_OK) + return(TCL_ERROR); + resObj = Tcl_NewListObj(0, NULL); + for(trl = tsl->reslist; trl; trl = trl->next){ + for(e = ldap_first_entry(trl->ld, trl->res); + e != NULL; + e = ldap_next_entry(trl->ld, e)){ + char *dn; + char **cn, **org, **unit, **title, **mail, **sn; + + dn = NULL; + cn = org = title = unit = mail = sn = NULL; + + itemObj = Tcl_NewListObj(0, NULL); + peLdapEntryParse(trl, e, &cn, &org, &unit, &title, + &mail, &sn); + if(cn){ + if(Tcl_ListObjAppendElement(interp, itemObj, + Tcl_NewStringObj(cn[0], -1)) != TCL_OK) + return(TCL_ERROR); + ldap_value_free(cn); + } + else if(sn){ + if(Tcl_ListObjAppendElement(interp, itemObj, + Tcl_NewStringObj(sn[0], -1)) != TCL_OK) + return(TCL_ERROR); + ldap_value_free(sn); + } + else{ + dn = ldap_get_dn(trl->ld, e); + + if(dn && !dn[0]){ + our_ldap_dn_memfree(dn); + dn = NULL; + } + + if(Tcl_ListObjAppendElement(interp, itemObj, + Tcl_NewStringObj(dn ? dn : "", -1)) != TCL_OK) + return(TCL_ERROR); + + if(dn) + our_ldap_dn_memfree(dn); + } + if(peLdapStrlist(interp, itemObj, title) == TCL_ERROR) + return(TCL_ERROR); + if(peLdapStrlist(interp, itemObj, unit) == TCL_ERROR) + return(TCL_ERROR); + if(peLdapStrlist(interp, itemObj, org) == TCL_ERROR) + return(TCL_ERROR); + if(peLdapStrlist(interp, itemObj, mail) == TCL_ERROR) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, resObj, itemObj) != TCL_OK) + return(TCL_ERROR); + if(title) + ldap_value_free(title); + if(unit) + ldap_value_free(unit); + if(org) + ldap_value_free(org); + if(mail) + ldap_value_free(mail); + } + } + if(Tcl_ListObjAppendElement(interp, secObj, resObj) != TCL_OK) + return(TCL_ERROR); + if(Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + secObj) != TCL_OK) + return(TCL_ERROR); + } + return(TCL_OK); +} + +int +peLdapStrlist(Tcl_Interp *interp, Tcl_Obj *itemObj, char **strl) +{ + Tcl_Obj *strlObj; + int i; + + strlObj = Tcl_NewListObj(0, NULL); + if(strl){ + for(i = 0; strl[i] && strl[i][0]; i++){ + if(Tcl_ListObjAppendElement(interp, strlObj, + Tcl_NewStringObj(strl[i], -1)) != TCL_OK) + return(TCL_ERROR); + } + } + if(Tcl_ListObjAppendElement(interp, itemObj, strlObj) != TCL_OK) + return(TCL_ERROR); + return(TCL_OK); +} + + +int +init_ldap_pname(struct pine *ps) +{ + if(!ps_global->VAR_PERSONAL_NAME + || ps_global->VAR_PERSONAL_NAME[0] == '\0'){ + char *pname; + struct variable *vtmp; + + if(ps->maildomain && *ps->maildomain + && ps->VAR_USER_ID && *ps->VAR_USER_ID){ + pname = peLdapPname(ps->VAR_USER_ID, ps->maildomain); + if(pname){ + vtmp = &ps->vars[V_PERSONAL_NAME]; + if((vtmp->fixed_val.p && vtmp->fixed_val.p[0] == '\0') + || (vtmp->is_fixed && !vtmp->fixed_val.p)){ + if(vtmp->fixed_val.p) + fs_give((void **)&vtmp->fixed_val.p); + vtmp->fixed_val.p = cpystr(pname); + } + else { + if(vtmp->global_val.p) + fs_give((void **)&vtmp->global_val.p); + vtmp->global_val.p = cpystr(pname); + } + fs_give((void **)&pname); + set_current_val(vtmp, FALSE, FALSE); + } + } + } + return 0; +} +#endif /* ENABLE_LDAP */ + +/* + * Note: this is taken straight out of pico/composer.c + * + * strqchr - returns pointer to first non-quote-enclosed occurance of ch in + * the given string. otherwise NULL. + * s -- the string + * ch -- the character we're looking for + * q -- q tells us if we start out inside quotes on entry and is set + * correctly on exit. + * m -- max characters we'll check for ch (set to -1 for no check) + */ +char * +strqchr(char *s, int ch, int *q, int m) +{ + int quoted = (q) ? *q : 0; + + for(; s && *s && m != 0; s++, m--){ + if(*s == '"'){ + quoted = !quoted; + if(q) + *q = quoted; + } + + if(!quoted && *s == ch) + return(s); + } + + return(NULL); +} + + +Tcl_Obj * +wp_prune_folders(CONTEXT_S *ctxt, + char *fcc, + int cur_month, + char *type, + unsigned pr, + int *ok, + int moved_fldrs, + Tcl_Interp *interp) +{ + Tcl_Obj *resObj = NULL, *secObj = NULL; + char path2[MAXPATH+1], tmp[21]; + int exists, month_to_use; + struct sm_folder *mail_list, *sm; + + mail_list = get_mail_list(ctxt, fcc); + + for(sm = mail_list; sm != NULL && sm->name != NULL; sm++) + if(sm->month_num == cur_month - 1) + break; /* matched a month */ + + month_to_use = (sm == NULL || sm->name == NULL) ? cur_month - 1 : 0; + + if(!(month_to_use == 0 || pr == PRUNE_NO_AND_ASK || pr == PRUNE_NO_AND_NO)){ + strncpy(path2, fcc, sizeof(path2)-1); + path2[sizeof(path2)-1] = '\0'; + strncpy(tmp, month_abbrev((month_to_use % 12)+1), sizeof(tmp)-1); + tmp[sizeof(tmp)-1] = '\0'; + lcase((unsigned char *) tmp); + snprintf(path2 + strlen(path2), sizeof(path2)-strlen(path2), "-%.20s-%d", tmp, month_to_use/12); + + if((exists = folder_exists(ctxt, fcc)) == FEX_ERROR){ + (*ok) = 0; + return(NULL); + } + else if(exists & FEX_ISFILE){ + if(pr == PRUNE_YES_AND_ASK || (pr == PRUNE_YES_AND_NO && !moved_fldrs)){ + prune_move_folder(fcc, path2, ctxt); + } else { + resObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj(type, -1)); + secObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, secObj, Tcl_NewStringObj(fcc, -1)); + Tcl_ListObjAppendElement(interp, secObj, Tcl_NewStringObj(path2, -1)); + Tcl_ListObjAppendElement(interp, resObj, secObj); + } + } + } + if(pr == PRUNE_ASK_AND_ASK || pr == PRUNE_YES_AND_ASK + || pr == PRUNE_NO_AND_ASK){ + sm = mail_list; + if(!resObj && sm && sm->name && sm->name[0] != '\0'){ + resObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj(type, -1)); + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewListObj(0, NULL)); + } + if(resObj) + secObj = Tcl_NewListObj(0, NULL); + for(sm = mail_list; sm != NULL && sm->name != NULL; sm++){ + if(sm->name[0] == '\0') /* can't happen */ + continue; + Tcl_ListObjAppendElement(interp, secObj, Tcl_NewStringObj(sm->name, -1)); + } + if(resObj) + Tcl_ListObjAppendElement(interp, resObj, secObj); + } else if(resObj) + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewListObj(0, NULL)); + + free_folder_list(ctxt); + + if((sm = mail_list) != NULL){ + while(sm->name){ + fs_give((void **)&(sm->name)); + sm++; + } + + fs_give((void **)&mail_list); + } + + return(resObj); +} + + +int +hex_colorstr(char *hexcolor, char *str) +{ + char *tstr, *p, *p2, tbuf[256]; + int i; + + strcpy(hexcolor, "000000"); + tstr = color_to_asciirgb(str); + p = tstr; + p2 = strindex(p, ','); + if(p2 == NULL) return 0; + strncpy(tbuf, p, min(50, p2-p)); + i = atoi(tbuf); + sprintf(hexcolor, "%2.2x", i); + p = p2+1; + p2 = strindex(p, ','); + if(p2 == NULL) return 0; + strncpy(tbuf, p, min(50, p2-p)); + i = atoi(tbuf); + sprintf(hexcolor+2, "%2.2x", i); + p = p2+1; + strncpy(tbuf, p, 50); + i = atoi(tbuf); + sprintf(hexcolor+4, "%2.2x", i); + + return 0; +} + +int +hexval(char ch) +{ + if(ch >= '0' && ch <= '9') + return (ch - '0'); + else if (ch >= 'A' && ch <= 'F') + return (10 + (ch - 'A')); + else if (ch >= 'a' && ch <= 'f') + return (10 + (ch - 'a')); + return -1; +} + +int +ascii_colorstr(char *acolor, char *hexcolor) +{ + int i, hv; + + if(strlen(hexcolor) > 6) return 1; + /* red value */ + if((hv = hexval(hexcolor[0])) == -1) return 1; + i = 16 * hv; + if((hv = hexval(hexcolor[1])) == -1) return 1; + i += hv; + sprintf(acolor, "%3.3d,", i); + /* green value */ + if((hv = hexval(hexcolor[2])) == -1) return 1; + i = 16 * hv; + if((hv = hexval(hexcolor[3])) == -1) return 1; + i += hv; + sprintf(acolor+4, "%3.3d,", i); + /* blue value */ + if((hv = hexval(hexcolor[4])) == -1) return 1; + i = 16 * hv; + if((hv = hexval(hexcolor[5])) == -1) return 1; + i += hv; + sprintf(acolor+8, "%3.3d", i); + + return 0; +} + + +char * +peRandomString(char *b, int l, int f) +{ + static char *kb = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; + char *s = b; + int j; + long n; + + while(1){ + n = random(); + for(j = 0; j < ((sizeof(long) * 8) / 5); j++){ + if(l-- <= 0){ + *s = '\0'; + return(b); + } + + switch(f){ + case PRS_LOWER_CASE : + *s++ = (char) tolower((unsigned char) kb[(n & 0x1F)]); + break; + + case PRS_MIXED_CASE : + if(random() % 2){ + *s++ = (char) tolower((unsigned char) kb[(n & 0x1F)]); + break; + } + + default : + *s++ = kb[(n & 0x1F)]; + break; + } + + n = n >> 5; + } + } +} + + +long +peAppendMsg(MAILSTREAM *stream, void *data, char **flags, char **date, STRING **message) +{ + char *t,*t1,tmp[MAILTMPLEN]; + unsigned long u; + MESSAGECACHE *elt; + APPEND_PKG *ap = (APPEND_PKG *) data; + *flags = *date = NIL; /* assume no flags or date */ + if (ap->flags) fs_give ((void **) &ap->flags); + if (ap->date) fs_give ((void **) &ap->date); + mail_gc (ap->stream,GC_TEXTS); + if (++ap->msgno <= ap->msgmax) { + /* initialize flag string */ + memset (t = tmp,0,MAILTMPLEN); + /* output system flags */ + if ((elt = mail_elt (ap->stream,ap->msgno))->seen) {strncat (t," \\Seen", sizeof(tmp)-(t-tmp)-1); tmp[sizeof(tmp)-1] = '\0';} + if (elt->deleted) {strncat (t," \\Deleted", sizeof(tmp)-(t-tmp)-1); tmp[sizeof(tmp)-1] = '\0';} + if (elt->flagged) {strncat (t," \\Flagged", sizeof(tmp)-(t-tmp)-1); tmp[sizeof(tmp)-1] = '\0';} + if (elt->answered) {strncat (t," \\Answered", sizeof(tmp)-(t-tmp)-1); tmp[sizeof(tmp)-1] = '\0';} + if (elt->draft) {strncat (t," \\Draft", sizeof(tmp)-(t-tmp)-1); tmp[sizeof(tmp)-1] = '\0';} + if ((u = elt->user_flags) != 0L) do /* any user flags? */ + if ((MAILTMPLEN - ((t += strlen (t)) - tmp)) > (long) + (2 + strlen + (t1 = ap->stream->user_flags[find_rightmost_bit (&u)]))) { + if(t-tmp < sizeof(tmp)) + *t++ = ' '; /* space delimiter */ + strncpy (t,t1,sizeof(tmp)-(t-tmp)); /* copy the user flag */ + } + while (u); /* until no more user flags */ + tmp[sizeof(tmp)-1] = '\0'; + *flags = ap->flags = cpystr (tmp + 1); + *date = ap->date = cpystr (mail_date (tmp,elt)); + *message = ap->message; /* message stringstruct */ + INIT (ap->message,mstring,(void *) ap,elt->rfc822_size); + } + else *message = NIL; /* all done */ + return LONGT; +} + + +/* Initialize file string structure for file stringstruct +* Accepts: string structure + * pointer to message data structure + * size of string + */ + +void +ms_init(STRING *s, void *data, unsigned long size) +{ + APPEND_PKG *md = (APPEND_PKG *) data; + s->data = data; /* note stream/msgno and header length */ + mail_fetchheader_full (md->stream,md->msgno,NIL,&s->data1,FT_PREFETCHTEXT); + mail_fetchtext_full (md->stream,md->msgno,&s->size,NIL); + s->size += s->data1; /* header + body size */ + SETPOS (s,0); +} + + +/* Get next character from file stringstruct + * Accepts: string structure + * Returns: character, string structure chunk refreshed + */ +char +ms_next(STRING *s) +{ + char c = *s->curpos++; /* get next byte */ + SETPOS (s,GETPOS (s)); /* move to next chunk */ + return c; /* return the byte */ +} + + +/* Set string pointer position for file stringstruct + * Accepts: string structure + * new position + */ +void +ms_setpos(STRING *s, unsigned long i) +{ + APPEND_PKG *md = (APPEND_PKG *) s->data; + if (i < s->data1) { /* want header? */ + s->chunk = mail_fetchheader (md->stream,md->msgno); + s->chunksize = s->data1; /* header length */ + s->offset = 0; /* offset is start of message */ + } + else if (i < s->size) { /* want body */ + s->chunk = mail_fetchtext (md->stream,md->msgno); + s->chunksize = s->size - s->data1; + s->offset = s->data1; /* offset is end of header */ + } + else { /* off end of message */ + s->chunk = NIL; /* make sure that we crack on this then */ + s->chunksize = 1; /* make sure SNX cracks the right way... */ + s->offset = i; + } + /* initial position and size */ + s->curpos = s->chunk + (i -= s->offset); + s->cursize = s->chunksize - i; +} + + +int +remote_pinerc_failure(void) +{ + snprintf(ps_global->last_error, sizeof(ps_global->last_error), "%s", + ps_global->c_client_error[0] + ? ps_global->c_client_error + : _("Unable to read remote configuration")); + + return(TRUE); +} + +char * +peWebAlpinePrefix(void) +{ + return("Web "); +} + + +void peNewMailAnnounce(MAILSTREAM *stream, long n, long t_nm_count){ + char subject[MAILTMPLEN+1], subjtext[MAILTMPLEN+1], from[MAILTMPLEN+1], + *folder = NULL, intro[MAILTMPLEN+1]; + long number; + ENVELOPE *e = NULL; + Tcl_Obj *resObj; + + if(n && (resObj = Tcl_NewListObj(0, NULL)) != NULL){ + + Tcl_ListObjAppendElement(peED.interp, resObj, Tcl_NewLongObj(number = sp_mail_since_cmd(stream))); + Tcl_ListObjAppendElement(peED.interp, resObj, Tcl_NewLongObj(mail_uid(stream, n))); + + if(stream){ + e = pine_mail_fetchstructure(stream, n, NULL); + + if(sp_flagged(stream, SP_INBOX)) + folder = NULL; + else{ + folder = STREAMNAME(stream); + if(folder[0] == '?' && folder[1] == '\0') + folder = NULL; + } + } + + format_new_mail_msg(folder, number, e, intro, from, subject, subjtext, sizeof(intro)); + + snprintf(tmp_20k_buf, SIZEOF_20KBUF, + "%s%s%s%.80s%.80s", intro, + from ? ((number > 1L) ? " Most recent f" : " F") : "", + from ? "rom " : "", + from ? from : "", + subjtext); + + Tcl_ListObjAppendElement(peED.interp, resObj, Tcl_NewStringObj(tmp_20k_buf,-1)); + + Tcl_ListObjAppendElement(peED.interp, Tcl_GetObjResult(peED.interp), resObj); + } +} + + +/* * * * * * * * * RSS 2.0 Support Routines * * * * * * * * * * * */ + +/* + * PERssCmd - RSS TCL interface + */ +int +PERssCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char *s1; + + dprint((2, "PERssCmd")); + + if(objc == 1){ + Tcl_WrongNumArgs(interp, 1, objv, "cmd ?args?"); + return(TCL_ERROR); + } + s1 = Tcl_GetStringFromObj(objv[1], NULL); + + if(s1){ + if(!strcmp(s1, "news")){ + return(peRssReturnFeed(interp, "news", ps_global->VAR_RSS_NEWS)); + } + else if(!strcmp(s1, "weather")){ + return(peRssReturnFeed(interp, "weather", ps_global->VAR_RSS_WEATHER)); + } + } + + Tcl_SetResult(interp, "Unknown PERss command", TCL_STATIC); + return(TCL_ERROR); +} + +/* + * peRssReturnFeed - fetch feed contents and package Tcl response + */ +int +peRssReturnFeed(Tcl_Interp *interp, char *type, char *link) +{ + RSS_FEED_S *feed; + char *errstr = "UNKNOWN"; + + if(link){ + ps_global->c_client_error[0] = '\0'; + + if((feed = peRssFeed(interp, type, link)) != NULL) + return(peRssPackageFeed(interp, feed)); + + if(ps_global->mm_log_error) + errstr = ps_global->c_client_error; + } + else + errstr = "missing setting"; + + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "%s feed fail: %s", type, errstr); + Tcl_SetResult(interp, tmp_20k_buf, TCL_VOLATILE); + return(TCL_ERROR); +} + +/* + * peRssPackageFeed - build a list of feed item elements + * + * LIST ORDER: {title} {link} {description} {image} + */ +int +peRssPackageFeed(Tcl_Interp *interp, RSS_FEED_S *feed) +{ + RSS_ITEM_S *item; + + for(item = feed->items; item; item = item->next) + if(peAppListF(interp, Tcl_GetObjResult(interp), "%s %s %s %s", + (item->title && *item->title)? item->title : "Feed Provided No Title", + item->link ? item->link : "", + item->description ? item->description : "", + feed->image ? feed->image : "") != TCL_OK) + return(TCL_ERROR); + + return(TCL_OK); +} + + +/* + * peRssFeed - return cached feed struct or fetch a new one + */ +RSS_FEED_S * +peRssFeed(Tcl_Interp *interp, char *type, char *link) +{ + int i, cache_l, cp_ref; + time_t now = time(0); + RSS_FEED_S *feed = NULL; + RSS_CACHE_S *cache, *cp; + static RSS_CACHE_S news_cache[RSS_NEWS_CACHE_SIZE], weather_cache[RSS_WEATHER_CACHE_SIZE]; + + if(!strucmp(type,"news")){ + cache = &news_cache[0]; + cache_l = RSS_NEWS_CACHE_SIZE; + } + else{ + cache = &weather_cache[0]; + cache_l = RSS_WEATHER_CACHE_SIZE; + } + + /* search/purge cache */ + for(i = 0; i < cache_l; i++) + if(cache[i].link){ + if(now > cache[i].stale){ + peRssClearCacheEntry(&cache[i]); + } + else if(!strcmp(link, cache[i].link)){ + cache[i].referenced++; + return(cache[i].feed); /* HIT! */ + } + } + + if((feed = peRssFetch(interp, link)) != NULL){ + /* find cache slot, and insert feed into cache */ + for(i = 0, cp_ref = 0; i < cache_l; i++) + if(!cache[i].feed){ + cp = &cache[i]; + break; + } + else if(cache[i].referenced >= cp_ref) + cp = &cache[i]; + + if(!cp) + cp = &cache[0]; /* failsafe */ + + peRssClearCacheEntry(cp); /* make sure */ + + cp->link = cpystr(link); + cp->feed = feed; + cp->referenced = 0; + cp->stale = now + (((feed->ttl > 0) ? feed->ttl : 60) * 60); + } + + return(feed); +} + +/* + * peRssFetch - follow the provided link an return the resulting struct + */ +RSS_FEED_S * +peRssFetch(Tcl_Interp *interp, char *link) +{ + char *scheme = NULL, *loc = NULL, *path = NULL, *parms = NULL, *query = NULL, *frag = NULL; + char *buffer = NULL, *bp, *p, *q; + int ttl = 60; + unsigned long port = 0L, buffer_len = 0L; + time_t theirdate = 0; + STORE_S *feed_so = NULL; + TCPSTREAM *tcp_stream; + + if(link){ + /* grok url */ + rfc1808_tokens(link, &scheme, &loc, &path, &parms, &query, &frag); + if(scheme && loc && path){ + if((p = strchr(loc,':')) != NULL){ + *p++ = '\0'; + while(*p && isdigit((unsigned char) *p)) + port = ((port * 10) + (*p++ - '0')); + + if(*p){ + Tcl_SetResult(interp, "Bad RSS port number", TCL_STATIC); + peRssComponentFree(&scheme,&loc,&path,&parms,&query,&frag); + return(NULL); + } + } + + if(scheme && !strucmp(scheme, "feed")){ + fs_give((void **) &scheme); + scheme = cpystr("http"); + } + + mail_parameters(NULL, SET_OPENTIMEOUT, (void *)(long) 5); + tcp_stream = tcp_open (loc, scheme, port | NET_NOOPENTIMEOUT); + mail_parameters(NULL, SET_OPENTIMEOUT, (void *)(long) 30); + + if(tcp_stream != NULL){ + char rev[128]; + + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "GET /%s%s%s%s%s HTTP/1.1\r\nHost: %s\r\nAccept: application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8\r\nAccept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\r\nUser-Agent: Web-Alpine/%s (%s %s)\r\n\r\n", + path, parms ? ":" : "", parms ? parms : "", + query ? "?" : "", query ? query : "", loc, + ALPINE_VERSION, SYSTYPE, get_alpine_revision_string(rev, sizeof(rev))); + + mail_parameters(NULL, SET_WRITETIMEOUT, (void *)(long) 5); + mail_parameters(NULL, SET_READTIMEOUT, (void *)(long) 5); + + if(tcp_sout(tcp_stream, tmp_20k_buf, strlen(tmp_20k_buf))){ + int ok = 0, chunked = FALSE; + + while((p = tcp_getline(tcp_stream)) != NULL){ + if(!ok){ + ok++; + if(strucmp(p,"HTTP/1.1 200 OK")){ + fs_give((void **) &p); + break; /* bail */ + } + } + else if(*p == '\0'){ /* first blank line, start of body */ + if(buffer || feed_so){ + fs_give((void **) &p); + break; /* bail */ + } + + if(buffer_len){ + buffer = fs_get(buffer_len + 16); + if(!tcp_getbuffer(tcp_stream, buffer_len, buffer)) + fs_give((void **) &buffer); + + fs_give((void **) &p); + break; /* bail */ + } + else if((feed_so = so_get(CharStar, NULL, EDIT_ACCESS)) == NULL){ + fs_give((void **) &p); + break; /* bail */ + } + } + else if(feed_so){ /* collect body */ + if(chunked){ + int chunk_len = 0, gotbuf; + + /* first line is chunk size in hex */ + for(q = p; *q && isxdigit((unsigned char) *q); q++) + chunk_len = (chunk_len * 16) + XDIGIT2C(*q); + + if(chunk_len > 0){ /* collect chunk */ + char *tbuf = fs_get(chunk_len + 16); + gotbuf = tcp_getbuffer(tcp_stream, chunk_len, tbuf); + if(gotbuf) + so_nputs(feed_so, tbuf, chunk_len); + + fs_give((void **) &tbuf); + + if(!gotbuf){ + fs_give((void **) &p); + break; /* bail */ + } + } + + /* collect trailing CRLF */ + gotbuf = ((q = tcp_getline(tcp_stream)) != NULL && *q == '\0'); + if(q) + fs_give((void **) &q); + + if(chunk_len == 0 || !gotbuf){ + fs_give((void **) &p); + break; /* bail */ + } + } + else + so_puts(feed_so, p); + } + else{ /* in header, grok fields */ + if(q = strchr(p,':')){ + int l = q - p; + + *q++ = '\0'; + while(isspace((unsigned char ) *q)) + q++; + + /* content-length */ + if(l == 4 && !strucmp(p, "date")){ + theirdate = date_to_local_time_t(q); + } + else if(l == 7 && !strucmp(p, "expires")){ + time_t expires = date_to_local_time_t(q) - ((theirdate > 0) ? theirdate : time(0)); + + if(expires > 0 && expires < (8 * 60 * 60)) + ttl = expires; + } + else if(l == 12 && !strucmp(p, "content-type") + && struncmp(q,"text/xml", 8) + && struncmp(q,"application/xhtml+xml", 21) + && struncmp(q,"application/rss+xml", 19) + && struncmp(q,"application/xml", 15)){ + fs_give((void **) &p); + break; /* bail */ + } + else if(l == 13 && !strucmp(p, "cache-control")){ + if(!struncmp(q,"max-age=",8)){ + int secs = 0; + + for(q += 8; *q && isdigit((unsigned char) *q); q++) + secs = ((secs * 10) + (*q - '0')); + + if(secs > 0) + ttl = secs; + } + } + else if(l == 14 && !strucmp(p,"content-length")){ + while(*q && isdigit((unsigned char) *q)) + buffer_len = ((buffer_len * 10) + (*q++ - '0')); + + if(*q){ + fs_give((void **) &p); + break; /* bail */ + } + } + else if(l == 17 && !strucmp(p, "transfer-encoding")){ + if(!struncmp(q,"chunked", 7)){ + chunked = TRUE; + } + else{ /* unknown encoding */ + fs_give((void **) &p); + break; /* bail */ + } + } + } + } + + fs_give((void **) &p); + } + } + else{ + Tcl_SetResult(interp, "RSS send failure", TCL_STATIC); + peRssComponentFree(&scheme,&loc,&path,&parms,&query,&frag); + } + + tcp_close(tcp_stream); + mail_parameters(NULL, SET_READTIMEOUT, (void *)(long) 60); + mail_parameters(NULL, SET_WRITETIMEOUT, (void *)(long) 60); + peRssComponentFree(&scheme,&loc,&path,&parms,&query,&frag); + + if(feed_so){ + buffer = (char *) so_text(feed_so); + buffer_len = (int) so_tell(feed_so); + } + + if(buffer && buffer_len){ + RSS_FEED_S *feed; + char *err; + STORE_S *bucket; + gf_io_t gc, pc; + + /* grok response */ + bucket = so_get(CharStar, NULL, EDIT_ACCESS); + gf_set_readc(&gc, buffer, buffer_len, CharStar, 0); + gf_set_so_writec(&pc, bucket); + gf_filter_init(); + gf_link_filter(gf_html2plain, gf_html2plain_rss_opt(&feed,0)); + if((err = gf_pipe(gc, pc)) != NULL){ + gf_html2plain_rss_free(&feed); + Tcl_SetResult(interp, "RSS connection failure", TCL_STATIC); + } + + so_give(&bucket); + + if(feed_so) + so_give(&feed_so); + else + fs_give((void **) &buffer); + + return(feed); + } + else + Tcl_SetResult(interp, "RSS response error", TCL_STATIC); + } + else + Tcl_SetResult(interp, "RSS connection failure", TCL_STATIC); + } + else + Tcl_SetResult(interp, "RSS feed missing scheme", TCL_STATIC); + } + else + Tcl_SetResult(interp, "No RSS Feed Defined", TCL_STATIC); + + return(NULL); +} + + +void +peRssComponentFree(char **scheme,char **loc,char **path,char **parms,char **query,char **frag) +{ + if(scheme) fs_give((void **) scheme); + if(loc) fs_give((void **) loc); + if(path) fs_give((void **) path); + if(parms) fs_give((void **) parms); + if(query) fs_give((void **) query); + if(frag) fs_give((void **) frag); +} + +void +peRssClearCacheEntry(RSS_CACHE_S *entry) +{ + if(entry){ + if(entry->link) + fs_give((void **) &entry->link); + + gf_html2plain_rss_free(&entry->feed); + memset(entry, 0, sizeof(RSS_CACHE_S)); + } +} diff --git a/web/src/alpined.d/alpined.h b/web/src/alpined.d/alpined.h new file mode 100644 index 00000000..b16fd5bc --- /dev/null +++ b/web/src/alpined.d/alpined.h @@ -0,0 +1,49 @@ +/*----------------------------------------------------------------------- + $Id: alpined.h 1142 2008-08-13 17:22:21Z hubert@u.washington.edu $ + -----------------------------------------------------------------------*/ + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +/* + * Various constants + */ +#define WP_MAXSTATUS 1024 + +/* + * Seconds afterwhich we bail on imap connections + */ +#define WP_TCP_TIMEOUT (10 * 60) + +/* + * buf to hold hostname for auth/cert + */ +#define CRED_REQ_SIZE 256 + +/* + * Various external definitions + */ +extern int peNoPassword; +extern int peCredentialError; +extern char peCredentialRequestor[]; +extern int peCertQuery; +extern int peCertFailure; +extern char *peSocketName; +extern STRLIST_S *peCertHosts; + +/* + * Protoypes for various functions + */ + +/* alpined.c */ +void sml_addmsg(int, char *); + diff --git a/web/src/alpined.d/alpineldap.c b/web/src/alpined.d/alpineldap.c new file mode 100644 index 00000000..c29ef7f4 --- /dev/null +++ b/web/src/alpined.d/alpineldap.c @@ -0,0 +1,181 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: alpineldap.c 1204 2009-02-02 19:54:23Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" +#include "../../../c-client/imap4r1.h" + +#include "../../../pith/osdep/color.h" /* color support library */ +#include "../../../pith/osdep/canaccess.h" +#include "../../../pith/osdep/temp_nam.h" + +#include "../../../pith/stream.h" +#include "../../../pith/context.h" +#include "../../../pith/state.h" +#include "../../../pith/msgno.h" +#include "../../../pith/debug.h" +#include "../../../pith/init.h" +#include "../../../pith/conf.h" +#include "../../../pith/conftype.h" +#include "../../../pith/detoken.h" +#include "../../../pith/flag.h" +#include "../../../pith/help.h" +#include "../../../pith/remote.h" +#include "../../../pith/status.h" +#include "../../../pith/mailcmd.h" +#include "../../../pith/savetype.h" +#include "../../../pith/save.h" +#include "../../../pith/reply.h" +#include "../../../pith/sort.h" +#include "../../../pith/ldap.h" +#include "../../../pith/addrbook.h" +#include "../../../pith/takeaddr.h" +#include "../../../pith/bldaddr.h" +#include "../../../pith/copyaddr.h" +#include "../../../pith/thread.h" +#include "../../../pith/folder.h" +#include "../../../pith/mailview.h" +#include "../../../pith/indxtype.h" +#include "../../../pith/mailindx.h" +#include "../../../pith/mailpart.h" +#include "../../../pith/mimedesc.h" +#include "../../../pith/detach.h" +#include "../../../pith/newmail.h" +#include "../../../pith/charset.h" +#include "../../../pith/util.h" +#include "../../../pith/rfc2231.h" +#include "../../../pith/string.h" +#include "../../../pith/send.h" + +#include "alpined.h" +#include "ldap.h" + +struct pine *ps_global; /* THE global variable! */ +char tmp_20k_buf[20480]; + +char *peSocketName; + +#ifdef ENABLE_LDAP +WPLDAP_S *wpldap_global; +#endif + +int peNoPassword, peCredentialError; +int peCertQuery, peCertFailure; +char peCredentialRequestor[CRED_REQ_SIZE]; +STRLIST_S *peCertHosts; + +void +sml_addmsg(priority, text) + int priority; + char *text; +{ +} + +void +peDestroyUserContext(pps) + struct pine **pps; +{ +} + +int +main(argc, argv) + int argc; + char *argv[]; +{ +#ifdef ENABLE_LDAP + struct pine *pine_state; + char *p = NULL, *userid = NULL, *domain = NULL, *pname; + struct variable *vars; + int i, usage = 0, rv = 0; + + pine_state = new_pine_struct(); + ps_global = pine_state; + vars = ps_global->vars; + debug = 0; + + for(i = 1 ; i < argc; i++){ + if(*argv[i] == '-'){ + switch (argv[i++][1]) { + case 'p': + p = argv[i]; + break; + case 'u': + userid = argv[i]; + break; + case 'd': + domain = argv[i]; + break; + default: + usage = rv = 1; + break; + } + } + else + usage = rv = 1; + if(usage == 1) break; + } + if(argc == 1) usage = rv = 1; + if (usage == 1 || !p || !userid){ + usage = rv = 1; + goto done; + } + wpldap_global = (WPLDAP_S *)fs_get(sizeof(WPLDAP_S)); + wpldap_global->query_no = 0; + wpldap_global->ldap_search_list = NULL; + + ps_global->pconf = new_pinerc_s(p); + if(ps_global->pconf) + read_pinerc(ps_global->pconf, vars, ParseGlobal); + else { + fprintf(stderr, "Failed to read pineconf\n"); + rv = 1; + goto done; + } + set_current_val(&ps_global->vars[V_LDAP_SERVERS], FALSE, FALSE); + set_current_val(&ps_global->vars[V_USER_DOMAIN], FALSE, FALSE); + if(!ps_global->VAR_USER_DOMAIN && !domain){ + fprintf(stderr, "No domain set in pineconf\n"); + usage = 1; + goto done; + } + if((pname = peLdapPname(userid, domain ? domain : ps_global->VAR_USER_DOMAIN)) != NULL){ + fprintf(stdout, "%s\n", pname); + fs_give((void **)&pname); + } + else + fprintf(stdout, "\n"); + +done: + if(usage) + fprintf(stderr, "usage: pineldap -u userid -p pineconf [-d domain]\n"); + if(wpldap_global){ + if(wpldap_global->ldap_search_list) + free_wpldapres(wpldap_global->ldap_search_list); + fs_give((void **)&wpldap_global); + } + if(ps_global->pconf) + free_pinerc_s(&ps_global->pconf); + free_pine_struct(&pine_state); + + exit(rv); +#else + fprintf(stderr, "%s: Not built with LDAP support\n", argv[0]); + exit(-1); +#endif +} + diff --git a/web/src/alpined.d/busy.c b/web/src/alpined.d/busy.c new file mode 100644 index 00000000..6f10fa7f --- /dev/null +++ b/web/src/alpined.d/busy.c @@ -0,0 +1,49 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: signal.c 91 2006-07-28 19:02:07Z mikes@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "../../../pith/status.h" +#include "../../../pith/busy.h" + + +/* + * Turn on a busy alarm. + */ +int +busy_cue(char *msg, percent_done_t pc_func, int init_msg) +{ + if(msg && !strncmp("Moving", msg, 6)){ + strncpy(msg+1, "Moved", 5); + q_status_message(SM_ORDER, 3, 3, msg+1); + } + + return(0); +} + + +/* + * If final_message was set when busy_cue was called: + * and message_pri = -1 -- no final message queued + * else final message queued with min equal to message_pri + */ +void +cancel_busy_cue(int message_pri) +{ +} + + diff --git a/web/src/alpined.d/color.c b/web/src/alpined.d/color.c new file mode 100644 index 00000000..e8d0af86 --- /dev/null +++ b/web/src/alpined.d/color.c @@ -0,0 +1,678 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: color.c 769 2007-10-24 00:15:40Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "../../../pith/osdep/color.h" +#include "../../../pith/osdep/collate.h" + + +static COLOR_PAIR *the_rev_color; +static char *_nfcolor, *_nbcolor, *_rfcolor, *_rbcolor; +static char *_last_fg_color, *_last_bg_color; +static int _force_fg_color_change, _force_bg_color_change; + + +/* * * * * * * PITH-REQUIRED COLOR ROUTINES * * * * * * */ + +/* internal prototypes */ +char *alpine_color_name(char *); +int alpine_valid_rgb(char *s); + +int +pico_usingcolor(void) +{ + return(TRUE); +} + + +int +pico_hascolor(void) +{ + return(TRUE); +} + + +/* + * Web Alpine Color Table + */ +static struct color_table { + int number; + char *rgb; + struct { + char *s, + l; + } name; +} webcoltab[] = { + {COL_BLACK, " 0, 0, 0", {"black", 5}}, + {COL_RED, "255, 0, 0", {"red", 3}}, + {COL_GREEN, " 0,255, 0", {"green", 5}}, + {COL_YELLOW, "255,255, 0", {"yellow", 6}}, + {COL_BLUE, " 0, 0,255", {"blue", 4}}, + {COL_MAGENTA, "255, 0,255", {"magenta", 7}}, + {COL_CYAN, " 0,255,255", {"cyan", 4}}, + {COL_WHITE, "255,255,255", {"white", 5}}, + {8, "192,192,192", {"color008", 8}}, /* light gray */ + {9, "128,128,128", {"color009", 8}}, /* gray */ + {10, " 64, 64, 64", {"color010", 8}}, /* dark gray */ + {COL_YELLOW, "255,255, 0", {"color011", 8}}, + {COL_BLUE, " 0, 0,255", {"color012", 8}}, + {COL_MAGENTA, "255, 0,255", {"color013", 8}}, + {COL_CYAN, " 0,255,255", {"color014", 8}}, + {COL_WHITE, "255,255,255", {"color015", 8}}, + {8, "192,192,192", {"colorlgr", 8}}, /* light gray */ + {9, "128,128,128", {"colormgr", 8}}, /* gray */ + {10, " 64, 64, 64", {"colordgr", 8}}, /* dark gray */ + {16, "000,000,000", {"color016", 8}}, + {17, "000,000,095", {"color017", 8}}, + {18, "000,000,135", {"color018", 8}}, + {19, "000,000,175", {"color019", 8}}, + {20, "000,000,215", {"color020", 8}}, + {21, "000,000,255", {"color021", 8}}, + {22, "000,095,000", {"color022", 8}}, + {23, "000,095,095", {"color023", 8}}, + {24, "000,095,135", {"color024", 8}}, + {25, "000,095,175", {"color025", 8}}, + {26, "000,095,215", {"color026", 8}}, + {27, "000,095,255", {"color027", 8}}, + {28, "000,135,000", {"color028", 8}}, + {29, "000,135,095", {"color029", 8}}, + {30, "000,135,135", {"color030", 8}}, + {31, "000,135,175", {"color031", 8}}, + {32, "000,135,215", {"color032", 8}}, + {33, "000,135,255", {"color033", 8}}, + {34, "000,175,000", {"color034", 8}}, + {35, "000,175,095", {"color035", 8}}, + {36, "000,175,135", {"color036", 8}}, + {37, "000,175,175", {"color037", 8}}, + {38, "000,175,215", {"color038", 8}}, + {39, "000,175,255", {"color039", 8}}, + {40, "000,215,000", {"color040", 8}}, + {41, "000,215,095", {"color041", 8}}, + {42, "000,215,135", {"color042", 8}}, + {43, "000,215,175", {"color043", 8}}, + {44, "000,215,215", {"color044", 8}}, + {45, "000,215,255", {"color045", 8}}, + {46, "000,255,000", {"color046", 8}}, + {47, "000,255,095", {"color047", 8}}, + {48, "000,255,135", {"color048", 8}}, + {49, "000,255,175", {"color049", 8}}, + {50, "000,255,215", {"color050", 8}}, + {51, "000,255,255", {"color051", 8}}, + {52, "095,000,000", {"color052", 8}}, + {53, "095,000,095", {"color053", 8}}, + {54, "095,000,135", {"color054", 8}}, + {55, "095,000,175", {"color055", 8}}, + {56, "095,000,215", {"color056", 8}}, + {57, "095,000,255", {"color057", 8}}, + {58, "095,095,000", {"color058", 8}}, + {59, "095,095,095", {"color059", 8}}, + {60, "095,095,135", {"color060", 8}}, + {61, "095,095,175", {"color061", 8}}, + {62, "095,095,215", {"color062", 8}}, + {63, "095,095,255", {"color063", 8}}, + {64, "095,135,000", {"color064", 8}}, + {65, "095,135,095", {"color065", 8}}, + {66, "095,135,135", {"color066", 8}}, + {67, "095,135,175", {"color067", 8}}, + {68, "095,135,215", {"color068", 8}}, + {69, "095,135,255", {"color069", 8}}, + {70, "095,175,000", {"color070", 8}}, + {71, "095,175,095", {"color071", 8}}, + {72, "095,175,135", {"color072", 8}}, + {73, "095,175,175", {"color073", 8}}, + {74, "095,175,215", {"color074", 8}}, + {75, "095,175,255", {"color075", 8}}, + {76, "095,215,000", {"color076", 8}}, + {77, "095,215,095", {"color077", 8}}, + {78, "095,215,135", {"color078", 8}}, + {79, "095,215,175", {"color079", 8}}, + {80, "095,215,215", {"color080", 8}}, + {81, "095,215,255", {"color081", 8}}, + {82, "095,255,000", {"color082", 8}}, + {83, "095,255,095", {"color083", 8}}, + {84, "095,255,135", {"color084", 8}}, + {85, "095,255,175", {"color085", 8}}, + {86, "095,255,215", {"color086", 8}}, + {87, "095,255,255", {"color087", 8}}, + {88, "135,000,000", {"color088", 8}}, + {89, "135,000,095", {"color089", 8}}, + {90, "135,000,135", {"color090", 8}}, + {91, "135,000,175", {"color091", 8}}, + {92, "135,000,215", {"color092", 8}}, + {93, "135,000,255", {"color093", 8}}, + {94, "135,095,000", {"color094", 8}}, + {95, "135,095,095", {"color095", 8}}, + {96, "135,095,135", {"color096", 8}}, + {97, "135,095,175", {"color097", 8}}, + {98, "135,095,215", {"color098", 8}}, + {99, "135,095,255", {"color099", 8}}, + {100, "135,135,000", {"color100", 8}}, + {101, "135,135,095", {"color101", 8}}, + {102, "135,135,135", {"color102", 8}}, + {103, "135,135,175", {"color103", 8}}, + {104, "135,135,215", {"color104", 8}}, + {105, "135,135,255", {"color105", 8}}, + {106, "135,175,000", {"color106", 8}}, + {107, "135,175,095", {"color107", 8}}, + {108, "135,175,135", {"color108", 8}}, + {109, "135,175,175", {"color109", 8}}, + {110, "135,175,215", {"color110", 8}}, + {111, "135,175,255", {"color111", 8}}, + {112, "135,215,000", {"color112", 8}}, + {113, "135,215,095", {"color113", 8}}, + {114, "135,215,135", {"color114", 8}}, + {115, "135,215,175", {"color115", 8}}, + {116, "135,215,215", {"color116", 8}}, + {117, "135,215,255", {"color117", 8}}, + {118, "135,255,000", {"color118", 8}}, + {119, "135,255,095", {"color119", 8}}, + {120, "135,255,135", {"color120", 8}}, + {121, "135,255,175", {"color121", 8}}, + {122, "135,255,215", {"color122", 8}}, + {123, "135,255,255", {"color123", 8}}, + {124, "175,000,000", {"color124", 8}}, + {125, "175,000,095", {"color125", 8}}, + {126, "175,000,135", {"color126", 8}}, + {127, "175,000,175", {"color127", 8}}, + {128, "175,000,215", {"color128", 8}}, + {129, "175,000,255", {"color129", 8}}, + {130, "175,095,000", {"color130", 8}}, + {131, "175,095,095", {"color131", 8}}, + {132, "175,095,135", {"color132", 8}}, + {133, "175,095,175", {"color133", 8}}, + {134, "175,095,215", {"color134", 8}}, + {135, "175,095,255", {"color135", 8}}, + {136, "175,135,000", {"color136", 8}}, + {137, "175,135,095", {"color137", 8}}, + {138, "175,135,135", {"color138", 8}}, + {139, "175,135,175", {"color139", 8}}, + {140, "175,135,215", {"color140", 8}}, + {141, "175,135,255", {"color141", 8}}, + {142, "175,175,000", {"color142", 8}}, + {143, "175,175,095", {"color143", 8}}, + {144, "175,175,135", {"color144", 8}}, + {145, "175,175,175", {"color145", 8}}, + {146, "175,175,215", {"color146", 8}}, + {147, "175,175,255", {"color147", 8}}, + {148, "175,215,000", {"color148", 8}}, + {149, "175,215,095", {"color149", 8}}, + {150, "175,215,135", {"color150", 8}}, + {151, "175,215,175", {"color151", 8}}, + {152, "175,215,215", {"color152", 8}}, + {153, "175,215,255", {"color153", 8}}, + {154, "175,255,000", {"color154", 8}}, + {155, "175,255,095", {"color155", 8}}, + {156, "175,255,135", {"color156", 8}}, + {157, "175,255,175", {"color157", 8}}, + {158, "175,255,215", {"color158", 8}}, + {159, "175,255,255", {"color159", 8}}, + {160, "215,000,000", {"color160", 8}}, + {161, "215,000,095", {"color161", 8}}, + {162, "215,000,135", {"color162", 8}}, + {163, "215,000,175", {"color163", 8}}, + {164, "215,000,215", {"color164", 8}}, + {165, "215,000,255", {"color165", 8}}, + {166, "215,095,000", {"color166", 8}}, + {167, "215,095,095", {"color167", 8}}, + {168, "215,095,135", {"color168", 8}}, + {169, "215,095,175", {"color169", 8}}, + {170, "215,095,215", {"color170", 8}}, + {171, "215,095,255", {"color171", 8}}, + {172, "215,135,000", {"color172", 8}}, + {173, "215,135,095", {"color173", 8}}, + {174, "215,135,135", {"color174", 8}}, + {175, "215,135,175", {"color175", 8}}, + {176, "215,135,215", {"color176", 8}}, + {177, "215,135,255", {"color177", 8}}, + {178, "215,175,000", {"color178", 8}}, + {179, "215,175,095", {"color179", 8}}, + {180, "215,175,135", {"color180", 8}}, + {181, "215,175,175", {"color181", 8}}, + {182, "215,175,215", {"color182", 8}}, + {183, "215,175,255", {"color183", 8}}, + {184, "215,215,000", {"color184", 8}}, + {185, "215,215,095", {"color185", 8}}, + {186, "215,215,135", {"color186", 8}}, + {187, "215,215,175", {"color187", 8}}, + {188, "215,215,215", {"color188", 8}}, + {189, "215,215,255", {"color189", 8}}, + {190, "215,255,000", {"color190", 8}}, + {191, "215,255,095", {"color191", 8}}, + {192, "215,255,135", {"color192", 8}}, + {193, "215,255,175", {"color193", 8}}, + {194, "215,255,215", {"color194", 8}}, + {195, "215,255,255", {"color195", 8}}, + {196, "255,000,000", {"color196", 8}}, + {197, "255,000,095", {"color197", 8}}, + {198, "255,000,135", {"color198", 8}}, + {199, "255,000,175", {"color199", 8}}, + {200, "255,000,215", {"color200", 8}}, + {201, "255,000,255", {"color201", 8}}, + {202, "255,095,000", {"color202", 8}}, + {203, "255,095,095", {"color203", 8}}, + {204, "255,095,135", {"color204", 8}}, + {205, "255,095,175", {"color205", 8}}, + {206, "255,095,215", {"color206", 8}}, + {207, "255,095,255", {"color207", 8}}, + {208, "255,135,000", {"color208", 8}}, + {209, "255,135,095", {"color209", 8}}, + {210, "255,135,135", {"color210", 8}}, + {211, "255,135,175", {"color211", 8}}, + {212, "255,135,215", {"color212", 8}}, + {213, "255,135,255", {"color213", 8}}, + {214, "255,175,000", {"color214", 8}}, + {215, "255,175,095", {"color215", 8}}, + {216, "255,175,135", {"color216", 8}}, + {217, "255,175,175", {"color217", 8}}, + {218, "255,175,215", {"color218", 8}}, + {219, "255,175,255", {"color219", 8}}, + {220, "255,215,000", {"color220", 8}}, + {221, "255,215,095", {"color221", 8}}, + {222, "255,215,135", {"color222", 8}}, + {223, "255,215,175", {"color223", 8}}, + {224, "255,215,215", {"color224", 8}}, + {225, "255,215,255", {"color225", 8}}, + {226, "255,255,000", {"color226", 8}}, + {227, "255,255,095", {"color227", 8}}, + {228, "255,255,135", {"color228", 8}}, + {229, "255,255,175", {"color229", 8}}, + {230, "255,255,215", {"color230", 8}}, + {231, "255,255,255", {"color231", 8}} +}; + + +char * +colorx(int color) +{ + int i; + static char cbuf[12]; + + for(i = 0; i < sizeof(webcoltab) / sizeof(struct color_table); i++) + if(color == webcoltab[i].number) + return(webcoltab[i].rgb); + + sprintf(cbuf, "color%3.3d", color); + return(cbuf); +} + + +/* + * Return a pointer to an rgb string for the input color. The output is 11 + * characters long and looks like rrr,ggg,bbb. + * + * Args colorName -- The color to convert to ascii rgb. + * + * Returns Pointer to a static buffer containing the rgb string. + */ +char * +color_to_asciirgb(char *colorName) +{ + int i; + static char c_to_a_buf[3][RGBLEN+1]; + static int whichbuf = 0; + + whichbuf = (whichbuf + 1) % 3; + + for(i = 0; i < sizeof(webcoltab) / sizeof(struct color_table); i++) + if(!strucmp(webcoltab[i].name.s, colorName)) + return(webcoltab[i].rgb); + + /* + * If we didn't find the color it could be that it is the + * normal color (MATCH_NORM_COLOR) or the none color + * (MATCH_NONE_COLOR). If that is the case, this strncpy thing + * will work out correctly because those two strings are + * RGBLEN long. Otherwise we're in a bit of trouble. This + * most likely means that the user is using the same pinerc on + * two terminals, one with more colors than the other. We didn't + * find a match because this color isn't present on this terminal. + * Since the return value of this function is assumed to be + * RGBLEN long, we'd better make it that long. + * It still won't work correctly because colors will be screwed up, + * but at least the embedded colors in filter.c will get properly + * sucked up when they're encountered. + */ + strncpy(c_to_a_buf[whichbuf], "xxxxxxxxxxx", RGBLEN); /* RGBLEN is 11 */ + i = strlen(colorName); + strncpy(c_to_a_buf[whichbuf], colorName, (i < RGBLEN) ? i : RGBLEN); + c_to_a_buf[whichbuf][RGBLEN] = '\0'; + return(c_to_a_buf[whichbuf]); +} + + + +int +pico_is_good_color(char *s) +{ + return(alpine_color_name(s) != NULL || alpine_valid_rgb(s)); +} + + +int +alpine_valid_rgb(char *s) +{ + int i, j; + + /* has to be three spaces or decimal digits followed by a dot.*/ + + for(i = 0; i < 3; i++){ + int n = 0; + + for(j = 0; j < 3; j++, s++) { + if(*s == ' '){ + if(n) + return(FALSE); + } + else if(isdigit((unsigned char) *s)){ + n = (n * 10) + (*s - '0'); + } + else + return(FALSE); + } + + if (i < 2 && *s++ != ',') + return(FALSE); + } + + return (TRUE); +} + + + +char * +alpine_color_name(char *s) +{ + if(s){ + int i; + + if(!struncmp(s, MATCH_NORM_COLOR, RGBLEN) || !struncmp(s, MATCH_NONE_COLOR, RGBLEN)) + return(s); + else if(*s == ' ' || isdigit(*s)){ + /* check for rgb string instead of name */ + for(i = 0; i < sizeof(webcoltab) / sizeof(struct color_table); i++) + if(!strncmp(webcoltab[i].rgb, s, RGBLEN)) + return(webcoltab[i].name.s); + } + else{ + for(i = 0; i < sizeof(webcoltab) / sizeof(struct color_table); i++) + if(!struncmp(webcoltab[i].name.s, s, webcoltab[i].name.l)) + return(webcoltab[i].name.s); + } + } + + return(NULL); +} + + +/* + * Sets color to (fg,bg). + * Flags == PSC_NONE No alternate default if fg,bg fails. + * == PSC_NORM Set it to Normal color on failure. + * == PSC_REV Set it to Reverse color on failure. + * + * If flag PSC_RET is set, returns an allocated copy of the previous + * color pair, otherwise returns NULL. + */ +COLOR_PAIR * +pico_set_colors(char *fg, char *bg, int flags) +{ + int uc; + COLOR_PAIR *cp = NULL, *rev = NULL; + + if(flags & PSC_RET) + cp = pico_get_cur_color(); + + if(!((uc = pico_usingcolor()) + && fg && bg + && pico_set_fg_color(fg) && pico_set_bg_color(bg))){ + + if(uc && flags & PSC_NORM){ + pico_set_normal_color(); + } + else if(flags & PSC_REV){ + if((rev = pico_get_rev_color()) != NULL){ + pico_set_fg_color(rev->fg); /* these will succeed */ + pico_set_bg_color(rev->bg); + } + } + } + + return(cp); +} + + + +void +pico_nfcolor(char *s) +{ + if(_nfcolor){ + free(_nfcolor); + _nfcolor = NULL; + } + + if(s){ + _nfcolor = (char *)malloc(strlen(s)+1); + if(_nfcolor) + strcpy(_nfcolor, s); + } +} + + +void +pico_nbcolor(char *s) +{ + if(_nbcolor){ + free(_nbcolor); + _nbcolor = NULL; + } + + if(s){ + _nbcolor = (char *)malloc(strlen(s)+1); + if(_nbcolor) + strcpy(_nbcolor, s); + } +} + +void +pico_rfcolor(char *s) +{ + if(_rfcolor){ + free(_rfcolor); + _rfcolor = NULL; + } + + if(s){ + _rfcolor = (char *)malloc(strlen(s)+1); + if(_rfcolor) + strcpy(_rfcolor, s); + + if(the_rev_color) + strcpy(the_rev_color->fg, _rfcolor); + } + else if(the_rev_color) + free_color_pair(&the_rev_color); +} + +void +pico_rbcolor(char *s) +{ + if(_rbcolor){ + free(_rbcolor); + _rbcolor = NULL; + } + + if(s){ + _rbcolor = (char *)malloc(strlen(s)+1); + if(_rbcolor) + strcpy(_rbcolor, s); + + if(the_rev_color) + strcpy(the_rev_color->bg, _rbcolor); + } + else if(the_rev_color) + free_color_pair(&the_rev_color); +} + + +void +pico_endcolor(void) +{ + if(_nfcolor){ + free(_nfcolor); + _nfcolor = NULL; + } + + if(_nbcolor){ + free(_nbcolor); + _nbcolor = NULL; + } + + if(_rfcolor){ + free(_rfcolor); + _rfcolor = NULL; + } + + if(_rbcolor){ + free(_rbcolor); + _rbcolor = NULL; + } + + if(the_rev_color) + free_color_pair(&the_rev_color); +} + + +COLOR_PAIR * +pico_get_cur_color(void) +{ + return(new_color_pair(_last_fg_color, _last_bg_color)); +} + +/* + * If inverse is a color, returns a pointer to that color. + * If not, returns NULL. + * + * NOTE: Don't free this! + */ +COLOR_PAIR * +pico_get_rev_color(void) +{ + if(pico_usingcolor() && _rfcolor && _rbcolor && + pico_is_good_color(_rfcolor) && pico_is_good_color(_rbcolor)){ + if(!the_rev_color) + the_rev_color = new_color_pair(_rfcolor, _rbcolor); + + return(the_rev_color); + } + else + return(NULL); +} + + +int +pico_set_fg_color(char *s) +{ + if(pico_is_good_color(s)){ + if(!struncmp(s, MATCH_NORM_COLOR, RGBLEN)) + s = _nfcolor; + else if(!struncmp(s, MATCH_NONE_COLOR, RGBLEN)) + return(TRUE); + + /* already set correctly */ + if(!_force_fg_color_change + && _last_fg_color + && !strcmp(_last_fg_color, s)) + return(TRUE); + + _force_fg_color_change = 0; + if(_last_fg_color) + free(_last_fg_color); + + if((_last_fg_color = (char *) malloc(strlen(s) + 1)) != NULL) + strcpy(_last_fg_color, s); + + return(TRUE); + } + + return(FALSE); +} + + +int +pico_set_bg_color(char *s) +{ + if(pico_is_good_color(s)){ + if(!struncmp(s, MATCH_NORM_COLOR, RGBLEN)) + s = _nbcolor; + else if(!struncmp(s, MATCH_NONE_COLOR, RGBLEN)) + return(TRUE); + + /* already set correctly */ + if(!_force_bg_color_change + && _last_bg_color + && !strcmp(_last_bg_color, s)) + return(TRUE); + + _force_bg_color_change = 0; + if(_last_bg_color) + free(_last_bg_color); + + if((_last_bg_color = (char *) malloc(strlen(s) + 1)) != NULL) + strcpy(_last_bg_color, s); + + return(TRUE); + } + + return(FALSE); +} + + +void +pico_set_normal_color(void) +{ + if(!_nfcolor || !_nbcolor || + !pico_set_fg_color(_nfcolor) || !pico_set_bg_color(_nbcolor)){ + (void)pico_set_fg_color(DEFAULT_NORM_FORE_RGB); + (void)pico_set_bg_color(DEFAULT_NORM_BACK_RGB); + } +} + + +char * +pico_get_last_fg_color(void) +{ + char *ret = NULL; + + if(_last_fg_color) + if((ret = (char *)malloc(strlen(_last_fg_color)+1)) != NULL) + strcpy(ret, _last_fg_color); + + return(ret); +} + +char * +pico_get_last_bg_color(void) +{ + char *ret = NULL; + + if(_last_bg_color) + if((ret = (char *)malloc(strlen(_last_bg_color)+1)) != NULL) + strcpy(ret, _last_bg_color); + + return(ret); +} diff --git a/web/src/alpined.d/color.h b/web/src/alpined.d/color.h new file mode 100644 index 00000000..3040ffbc --- /dev/null +++ b/web/src/alpined.d/color.h @@ -0,0 +1,25 @@ +/*----------------------------------------------------------------------- + $Id: color.h 764 2007-10-23 23:44:49Z hubert@u.washington.edu $ + -----------------------------------------------------------------------*/ + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#ifndef _WEB_ALPINE_COLOR_INCLUDED +#define _WEB_ALPINE_COLOR_INCLUDED + +void pico_endcolor(void); + +#endif /* _WEB_ALPINE_COLOR_INCLUDED */ + + + diff --git a/web/src/alpined.d/debug.c b/web/src/alpined.d/debug.c new file mode 100644 index 00000000..d3c4d2b7 --- /dev/null +++ b/web/src/alpined.d/debug.c @@ -0,0 +1,151 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: wimap.c 73 2006-06-13 16:46:59Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +/*====================================================================== + debug.c + Provide debug support routines + ====*/ + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" + +#include "../../../pith/state.h" +#include "../../../pith/debug.h" + +#include "debug.h" + + +#define MAX_DEBUG_FMT 1024 + + +#ifndef DEBUG +/* + * Preserve debug for syslog trace + */ +int debug; +#endif + + +void +debug_init(void) +{ +#if HAVE_SYSLOG + openlog("alpined", LOG_PID, LOG_MAIL); +#endif +} + + +void +output_debug_msg(int dlevel, char *fmt, ...) +{ + /* always write SYSDBG */ + if((dlevel & SYSDBG) || dlevel <= debug){ +#if HAVE_SYSLOG + va_list args; + char fmt2[MAX_DEBUG_FMT], *p, *q, *trailing = NULL; + int priority = LOG_DEBUG, leading = 1; + + /* whack nl's */ + for(p = fmt, q = fmt2; *p && p - fmt < MAX_DEBUG_FMT - 2; p++){ + if(*p == '\n'){ + if(!leading && !trailing) + trailing = q; + } + else{ + leading = 0; + if(trailing){ + *q++ = '_'; + trailing = NULL; + } + + *q++ = *p; + } + } + + *q = '\0'; + if(trailing) + *trailing = '\0'; + + if(dlevel & SYSDBG) + switch(dlevel){ + case SYSDBG_ALERT : priority = LOG_ALERT; break; + case SYSDBG_ERR : priority = LOG_ERR; break; + case SYSDBG_INFO : priority = LOG_INFO; break; + default : priority = LOG_DEBUG; break; + } + + + va_start(args, fmt); + vsyslog(priority, fmt2, args); + va_end(args); +#else +# error Write something to record error/debugging output +#endif + } +} + +#ifdef DEBUG + +void +dump_configuration(int brief) +{ + dprint((8, "asked to dump_configuration")); +} + + +void +dump_contexts(void) +{ + dprint((8, "asked to dump_contexts")); +} + + +void +setup_imap_debug(void) +{ + int olddebug; + + olddebug = debug; + + if(debug > 7) + ps_global->debug_imap = 4; + else if(debug > 6) + ps_global->debug_imap = 3; + else if(debug > 4) + ps_global->debug_imap = 2; + else if(debug > 2) + ps_global->debug_imap = 1; + else + ps_global->debug_imap = 0; + + if(ps_global->mail_stream){ + if(ps_global->debug_imap > 0){ + mail_debug(ps_global->mail_stream); + } + else{ + mail_nodebug(ps_global->mail_stream); + } + } + + if(debug > 7 && olddebug <= 7) + mail_parameters(NULL, SET_TCPDEBUG, (void *) TRUE); + else if(debug <= 7 && olddebug > 7 && !ps_global->debugmem) + mail_parameters(NULL, SET_TCPDEBUG, (void *) FALSE); + +} +#endif /* DEBUG */ diff --git a/web/src/alpined.d/debug.h b/web/src/alpined.d/debug.h new file mode 100644 index 00000000..9a44ba81 --- /dev/null +++ b/web/src/alpined.d/debug.h @@ -0,0 +1,52 @@ +/*----------------------------------------------------------------------- + $Id: debug.h 130 2006-09-22 04:39:36Z mikes@u.washington.edu $ + -----------------------------------------------------------------------*/ + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#ifndef _WEB_ALPINE_DEBUG_INCLUDED +#define _WEB_ALPINE_DEBUG_INCLUDED + + +#ifndef DEBUG +/* + * support dprint regardless so we leave at least a few + * footsteps in syslog + */ +#undef dprint +#define dprint(x) { output_debug_msg x ; } + +/* alpined-scoped debugging level */ +extern int debug; + +void output_debug_msg(int, char *fmt, ...); +#endif + + +/* + * Use these to for dprint() debug level arg to force + * debug output (typically to syslog()) + */ +#define SYSDBG 0x8000 +#define SYSDBG_ALERT SYSDBG+1 +#define SYSDBG_ERR SYSDBG+2 +#define SYSDBG_INFO SYSDBG+3 +#define SYSDBG_DEBUG SYSDBG+4 + + +/* exported prototypes */ +void debug_init(void); +void setup_imap_debug(void); + + +#endif /* _WEB_ALPINE_DEBUG_INCLUDED */ diff --git a/web/src/alpined.d/imap.c b/web/src/alpined.d/imap.c new file mode 100644 index 00000000..6872d085 --- /dev/null +++ b/web/src/alpined.d/imap.c @@ -0,0 +1,516 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: imap.c 1142 2008-08-13 17:22:21Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +/*====================================================================== + imap.c + The call back routines for the c-client/imap + - handles error messages and other notification + - handles prelimirary notification of new mail and expunged mail + - prompting for imap server login and password + + ====*/ + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" + +#include "../../../pith/state.h" +#include "../../../pith/debug.h" +#include "../../../pith/string.h" +#include "../../../pith/flag.h" +#include "../../../pith/imap.h" +#include "../../../pith/status.h" +#include "../../../pith/osdep/collate.h" + +#include "debug.h" +#include "alpined.h" + + + +/* + * Internal prototypes + */ +long imap_seq_exec(MAILSTREAM *, char *,long (*)(MAILSTREAM *, long, void *), void *); +long imap_seq_exec_append(MAILSTREAM *, long, void *); + + +/* + * Exported globals setup by searching functions to tell mm_searched + * where to put message numbers that matched the search criteria, + * and to allow mm_searched to return number of matches. + */ +MAILSTREAM *mm_search_stream; + +MM_LIST_S *mm_list_info; + + + +/*---------------------------------------------------------------------- + Queue imap log message for display in the message line + + Args: string -- The message + errflg -- flag set to 1 if pertains to an error + + Result: Message queued for display + + The c-client/imap reports most of it's status and errors here + ---*/ +void +mm_log(char *string, long errflg) +{ + char message[300]; + char *occurance; + int was_capitalized; + time_t now; + struct tm *tm_now; + + if(errflg == ERROR){ + dprint((SYSDBG_ERR, "%.*s (%ld)", 128, string, errflg)); + } + + now = time((time_t *)0); + tm_now = localtime(&now); + + dprint((ps_global->debug_imap ? 0 : (errflg == ERROR ? 1 : 2), + "IMAP %2.2d:%2.2d:%2.2d %d/%d mm_log %s: %s\n", + tm_now->tm_hour, tm_now->tm_min, tm_now->tm_sec, tm_now->tm_mon+1, + tm_now->tm_mday, + (errflg == ERROR) + ? "ERROR" + : (errflg == WARN) + ? "warn" + : (errflg == PARSE) + ? "parse" + : "babble", + string)); + + if(errflg == ERROR && !strncmp(string, "[TRYCREATE]", 11)){ + ps_global->try_to_create = 1; + return; + } + else if(ps_global->try_to_create + || (sp_dead_stream(ps_global->mail_stream) + && (!strncmp(string, "[CLOSED]", 8) || strstr(string, "No-op")))) + /* + * Don't display if creating new folder OR + * warning about a dead stream ... + */ + return; + + /*---- replace all "mailbox" with "folder" ------*/ + strncpy(message, string, sizeof(message)); + message[sizeof(message) - 1] = '\0'; + occurance = srchstr(message, "mailbox"); + while(occurance) { + if(!*(occurance+7) || isspace((unsigned char)*(occurance+7))){ + was_capitalized = isupper((unsigned char)*occurance); + rplstr(occurance, 7, 7, (errflg == PARSE ? "address" : "folder")); + if(was_capitalized) + *occurance = (errflg == PARSE ? 'A' : 'F'); + } + else + occurance += 7; + + occurance = srchstr(occurance, "mailbox"); + } + + if(errflg == ERROR) + ps_global->mm_log_error = 1; + + if(errflg == PARSE || (errflg == ERROR && ps_global->noshow_error)){ + strncpy(ps_global->c_client_error, message, sizeof(ps_global->c_client_error)); + ps_global->c_client_error[sizeof(ps_global->c_client_error)-1] = '\0'; + } + + if(ps_global->noshow_error + || (ps_global->noshow_warn && errflg == WARN) + || !(errflg == ERROR || errflg == WARN)) + return; /* Only care about errors; don't print when asked not to */ + + /*---- Display the message ------*/ + q_status_message((errflg == ERROR) ? (SM_ORDER | SM_DING) : SM_ORDER, + 3, 5, message); + if(errflg == ERROR){ + strncpy(ps_global->last_error, message, sizeof(ps_global->last_error)); + ps_global->last_error[sizeof(ps_global->last_error)-1] = '\0'; + } +} + + + +/*---------------------------------------------------------------------- + recieve notification from IMAP + + Args: stream -- Mail stream message is relavant to + string -- The message text + errflag -- Set if it is a serious error + + Result: message displayed in status line + + The facility is for general notices, such as connection to server; + server shutting down etc... It is used infrequently. + ----------------------------------------------------------------------*/ +void +mm_notify(MAILSTREAM *stream, char *string, long errflag) +{ + if(errflag == ERROR){ + dprint((SYSDBG_ERR, "mm_notify: %s (%ld)", string, errflag)); + } + + /* be sure to log the message... */ +#ifdef DEBUG + if(ps_global->debug_imap) + dprint((0, "IMAP mm_notify %s : %s (%s) : %s\n", + (!errflag) ? "NIL" : + (errflag == ERROR) ? "error" : + (errflag == WARN) ? "warning" : + (errflag == BYE) ? "bye" : "unknown", + (stream && stream->mailbox) ? stream->mailbox : "-no folder-", + (stream && stream == sp_inbox_stream()) ? "inboxstream" : + (stream && stream == ps_global->mail_stream) ? "mailstream" : + (stream) ? "abookstream?" : "nostream", + string)); +#endif + + strncpy(ps_global->last_error, string, 500); + ps_global->last_error[499] = '\0'; + + /* + * Then either set special bits in the pine struct or + * display the message if it's tagged as an "ALERT" or + * its errflag > NIL (i.e., WARN, or ERROR) + */ + if(errflag == BYE){ + if(stream == ps_global->mail_stream){ + if(sp_dead_stream(ps_global->mail_stream)) + return; + else + sp_set_dead_stream(ps_global->mail_stream, 1); + } + else if(stream && stream == sp_inbox_stream()){ + if(sp_dead_stream(stream)) + return; + else + sp_set_dead_stream(stream, 1); + } + } + else if(!strncmp(string, "[TRYCREATE]", 11)) + ps_global->try_to_create = 1; + else if(!strncmp(string, "[ALERT]", 7)) + q_status_message2(SM_MODAL, 3, 3, "Alert received while accessing \"%s\": %s", + (stream && stream->mailbox) + ? stream->mailbox : "-no folder-", + rfc1522_decode_to_utf8((unsigned char *) tmp_20k_buf, SIZEOF_20KBUF, string)); + else if(!strncmp(string, "[UNSEEN ", 8)){ + char *p; + long n = 0; + + for(p = string + 8; isdigit(*p); p++) + n = (n * 10) + (*p - '0'); + + sp_set_first_unseen(ps_global->mail_stream, n); + } + else if(!strncmp(string, "[READ-ONLY]", 11) + && !(stream && stream->mailbox && IS_NEWS(stream))) + q_status_message2(SM_ORDER | SM_DING, 3, 3, "%s : %s", + (stream && stream->mailbox) + ? stream->mailbox : "-no folder-", + string + 11); + else if(errflag && (errflag == WARN || errflag == ERROR)) + q_status_message(SM_ORDER | ((errflag == ERROR) ? SM_DING : 0), + 3, 6, ps_global->last_error); +} + + + +/*---------------------------------------------------------------------- + Do work of getting login and password from user for IMAP login + + Args: mb -- The mail box property struct + user -- Buffer to return the user name in + passwd -- Buffer to return the passwd in + trial -- The trial number or number of attempts to login + + Result: username and password passed back to imap + ----*/ +void +mm_login_work(NETMBX *mb, char *user, char *pwd, long trial, char *usethisprompt, char *altuserforcache) +{ + STRLIST_S hostlist[2]; + NETMBX cmb; + int l; + + pwd[0] = '\0'; + + if((l = strlen(mb->orighost)) > 0 && l < CRED_REQ_SIZE) + strcpy(peCredentialRequestor, mb->orighost); + + if(trial){ /* one shot only! */ + user[0] = '\0'; + peCredentialError = 1; + return; + } + +#if 0 + if(ps_global && ps_global->anonymous) { + /*------ Anonymous login mode --------*/ + if(trial < 1) { + strcpy(user, "anonymous"); + sprintf(pwd, "%s@%s", ps_global->VAR_USER_ID, + ps_global->hostname); + } + else + user[0] = pwd[0] = '\0'; + + return; + } +#endif + +#if WEB_REQUIRE_SECURE_IMAP + /* we *require* secure authentication */ + if(!(mb->sslflag || mb->tlsflag) && strcmp("localhost",mb->host)){ + user[0] = pwd[0] = '\0'; + return; + } +#endif + + /* + * heavily paranoid about offering password to server + * that the users hasn't also indicated the remote user + * name + */ + if(*mb->user){ + strcpy(user, mb->user); + } + else if(ps_global->prc + && ps_global->prc->name + && mail_valid_net_parse(ps_global->prc->name,&cmb) + && cmb.user){ + strcpy(user, cmb.user); + } + else{ + /* + * don't blindly offer user/pass + */ + user[0] = pwd[0] = '\0'; + return; + } + + /* + * set up host list for sybil servers... + */ + hostlist[0].name = mb->host; + if(mb->orighost[0] && strucmp(mb->host, mb->orighost)){ + hostlist[0].next = &hostlist[1]; + hostlist[1].name = mb->orighost; + hostlist[1].next = NULL; + } + else + hostlist[0].next = NULL; + + /* try last working password associated with this host. */ + if(!imap_get_passwd(mm_login_list, pwd, user, hostlist, (mb->sslflag || mb->tlsflag))){ + peNoPassword = 1; + user[0] = pwd[0] = '\0'; + } +} + + + +/*---------------------------------------------------------------------- + Receive notification of an error writing to disk + + Args: stream -- The stream the error occured on + errcode -- The system error code (errno) + serious -- Flag indicating error is serious (mail may be lost) + +Result: If error is non serious, the stream is marked as having an error + and deletes are disallowed until error clears + If error is serious this returns with syslogging if possible + ----*/ +long +mm_diskerror (MAILSTREAM *stream, long errcode, long serious) +{ + if(!serious && stream == ps_global->mail_stream) { + sp_set_io_error_on_stream(ps_global->mail_stream, 1); + } + + dprint((SYSDBG_ERR, "mm_diskerror: mailbox: %s, errcode: %ld, serious: %ld\n", + (stream && stream->mailbox) ? stream->mailbox : "", errcode, serious)); + + return(1); +} + + +/* + * alpine_tcptimeout - C-client callback to handle tcp-related timeouts. + */ +long +alpine_tcptimeout(long elapsed, long sincelast) +{ + long rv = 1L; /* keep trying by default */ + + dprint((SYSDBG_INFO, "tcptimeout: waited %s seconds\n", long2string(elapsed))); + + if(elapsed > WP_TCP_TIMEOUT){ + dprint((SYSDBG_ERR, "tcptimeout: BAIL after %s seconds\n", long2string(elapsed))); + rv = 0L; + } + + return(rv); +} + + +/* + * C-client callback to handle SSL/TLS certificate validation failures + * + * Returning 0 means error becomes fatal + * Non-zero means certificate problem is ignored and SSL session is + * established + * + * We remember the answer and won't re-ask for subsequent open attempts to + * the same hostname. + */ +long +alpine_sslcertquery(char *reason, char *host, char *cert) +{ + static char buf[256]; + STRLIST_S *p; + + for(p = peCertHosts; p; p = p->next) + if(!strucmp(p->name, host)) + return(1); + + peCertQuery = 1; + snprintf(peCredentialRequestor, CRED_REQ_SIZE, "%s++%s", host ? host : "?", reason ? reason : "UNKNOWN"); + q_status_message(SM_ORDER, 0, 3, "SSL Certificate Problem"); + dprint((SYSDBG_INFO, "sslcertificatequery: host=%s reason=%s cert=%s\n", + host ? host : "?", reason ? reason : "?", + cert ? cert : "?")); + return(0); +} + + +/* + * C-client callback to handle SSL/TLS certificate validation failures + */ +void +alpine_sslfailure(char *host, char *reason, unsigned long flags) +{ + peCertFailure = 1; + snprintf(peCredentialRequestor, CRED_REQ_SIZE, "%s++%s", host ? host : "?", reason ? reason : "UNKNOWN"); + q_status_message1(SM_ORDER, 0, 3, "SSL Certificate Failure: %s", reason ? reason : "?"); + dprint((SYSDBG_INFO, "SSL Invalid Cert (%s) : %s", host, reason)); +} + + + +/*---------------------------------------------------------------------- + This can be used to prevent the flickering of the check_cue char + caused by numerous (5000+) fetches by c-client. Right now, the only + practical use found is newsgroup subsciption. + + check_cue_display will check if this global is set, and won't clear + the check_cue_char if set. + ----*/ +void +set_read_predicted(int i) +{ +} + +/*---------------------------------------------------------------------- + Exported method to display status of mail check + + Args: putstr -- should be NO LONGER THAN 2 bytes + + Result: putstr displayed at upper-left-hand corner of screen + ----*/ +void +check_cue_display(char *putstr) +{ +} + + + +void +alpine_set_passwd(char *user, char *passwd, char *host, int altflag) +{ + STRLIST_S hostlist[1]; + + hostlist[0].name = host; + hostlist[0].next = NULL; + + imap_set_passwd(&mm_login_list, passwd, user, hostlist, altflag, 1, 0); +} + + +void +alpine_clear_passwd(char *user, char *host) +{ + MMLOGIN_S **lp, *l; + STRLIST_S hostlist[1]; + + hostlist[0].name = host; + hostlist[0].next = NULL; + + for(lp = &mm_login_list; *lp; lp = &(*lp)->next) + if(imap_same_host((*lp)->hosts, hostlist) + && (!*user || !strcmp(user, (*lp)->user))){ + l = *lp; + *lp = (*lp)->next; + + if(l->user) + fs_give((void **) &l->user); + + free_strlist(&l->hosts); + + if(l->passwd){ + char *p = l->passwd; + + while(*p) + *p++ = '\0'; + } + + fs_give((void **) &l); + + break; + } +} + + +int +alpine_have_passwd(char *user, char *host, int altflag) +{ + STRLIST_S hostlist[1]; + + hostlist[0].name = host; + hostlist[0].next = NULL; + + return(imap_get_passwd(mm_login_list, NULL, user, hostlist, altflag)); +} + + +char * +alpine_get_user(char *host) +{ + STRLIST_S hostlist[1]; + + hostlist[0].name = host; + hostlist[0].next = NULL; + + return(imap_get_user(mm_login_list, hostlist)); +} diff --git a/web/src/alpined.d/imap.h b/web/src/alpined.d/imap.h new file mode 100644 index 00000000..024e1781 --- /dev/null +++ b/web/src/alpined.d/imap.h @@ -0,0 +1,23 @@ +/*----------------------------------------------------------------------- + $Id: imap.h 82 2006-07-12 23:36:59Z mikes@u.washington.edu $ + -----------------------------------------------------------------------*/ + +#ifndef _WEB_ALPINE_IMAP_INCLUDED +#define _WEB_ALPINE_IMAP_INCLUDED + + +#include "../../../pith/imap.h" + + +/* exported protoypes */ +long alpine_tcptimeout(long, long); +long alpine_sslcertquery(char *, char *, char *); +void alpine_sslfailure(char *, char *, unsigned long); +void alpine_set_passwd(char *, char *, char *, int); +void alpine_clear_passwd(char *, char *); +int alpine_have_passwd(char *, char *, int); +char *alpine_get_user(char *, int); + + + +#endif /* _WEB_ALPINE_IMAP_INCLUDED */ diff --git a/web/src/alpined.d/ldap.c b/web/src/alpined.d/ldap.c new file mode 100644 index 00000000..3e6bf99f --- /dev/null +++ b/web/src/alpined.d/ldap.c @@ -0,0 +1,241 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: ldap.c 1266 2009-07-14 18:39:12Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2008 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" + +#include "../../../pith/state.h" +#include "../../../pith/debug.h" +#include "../../../pith/adrbklib.h" +#include "../../../pith/ldap.h" + +#include "ldap.h" + + +#ifdef ENABLE_LDAP + +int +ldap_addr_select(ps, ac, result, style, wp_err, srchstr) + struct pine *ps; + ADDR_CHOOSE_S *ac; + LDAP_CHOOSE_S **result; + LDAPLookupStyle style; + WP_ERR_S *wp_err; + char *srchstr; +{ + LDAP_SERV_RES_S *res_list, *tmp_rl; + LDAPMessage *e, *tmp_e; + char **mail = NULL, *a; + int got_n_entries = 0, retval = -5; + BerElement *ber; + + dprint((7, "ldap_addr_select, srchstr: %s", srchstr)); + for(res_list = ac->res_head; res_list; res_list = res_list->next){ + tmp_rl = res_list; + for(e = ldap_first_entry(res_list->ld, res_list->res); + e != NULL; + e = ldap_next_entry(res_list->ld, e)){ + tmp_e = e; + got_n_entries++; + } + } + if(got_n_entries == 1){ + for(a = ldap_first_attribute(tmp_rl->ld, tmp_e, &ber); + a != NULL; + a = ldap_next_attribute(tmp_rl->ld, tmp_e, ber)){ + if(strcmp(a, tmp_rl->info_used->mailattr) == 0){ + mail = ldap_get_values(tmp_rl->ld, tmp_e, a); + break; + } + } + if(mail && mail[0] && mail[0][0]){ + retval = 0; + if(result){ + (*result) = + (LDAP_CHOOSE_S *)fs_get(sizeof(LDAP_CHOOSE_S)); + (*result)->ld = tmp_rl->ld; + (*result)->selected_entry = tmp_e; + (*result)->info_used = tmp_rl->info_used; + (*result)->serv = tmp_rl->serv; + } + } + else{ + retval = -2; + } + } + else + retval = -3; + + return(retval); +} + + +char * +peLdapPname(mailbox, host) + char *mailbox; + char *host; +{ + char *retstr = NULL; + char adrstr[1024], **cn; + int ecnt; + CUSTOM_FILT_S *filter; + WP_ERR_S wp_err; + LDAP_CHOOSE_S *winning_e = NULL; + LDAP_SERV_RES_S *results = NULL; + LDAP_SERV_RES_S *trl; + LDAPMessage *e; + + sprintf(adrstr, "(mail=%.500s@%.500s)", mailbox, host); + filter = (CUSTOM_FILT_S *)fs_get(sizeof(CUSTOM_FILT_S)); + filter->filt = cpystr(adrstr); + filter->combine = 0; + memset(&wp_err, 0, sizeof(wp_err)); + wpldap_global->query_no++; + if(wpldap_global->ldap_search_list){ + wpldap_global->ldap_search_list = + free_wpldapres(wpldap_global->ldap_search_list); + } + ldap_lookup_all("", 0, 0, AlwaysDisplay, filter, &winning_e, + &wp_err, &results); + if(filter){ + fs_give((void **)&filter->filt); + fs_give((void **)&filter); + } + if(wpldap_global->ldap_search_list){ + trl = wpldap_global->ldap_search_list->reslist; + for(ecnt = 0, e = ldap_first_entry(trl->ld, trl->res); + e != NULL; e = ldap_next_entry(trl->ld, e), ecnt++); + if(ecnt == 1) { /* found the one true name */ + e = ldap_first_entry(trl->ld, trl->res); + peLdapEntryParse(trl, e, &cn, NULL, NULL, NULL, + NULL, NULL); + if(cn){ + retstr = cpystr(cn[0]); + ldap_value_free(cn); + } + } + } + return(retstr); +} + +int +peLdapEntryParse(trl, e, ret_cn, ret_org, ret_unit, + ret_title, ret_mail, ret_sn) + LDAP_SERV_RES_S *trl; + LDAPMessage *e; + char ***ret_cn; + char ***ret_org; + char ***ret_unit; + char ***ret_title; + char ***ret_mail; + char ***ret_sn; +{ + char *a, **cn, **org, **unit, **title, **mail, **sn; + BerElement *ber; + + cn = org = title = unit = mail = sn = NULL; + + for(a = ldap_first_attribute(trl->ld, e, &ber); + a != NULL; + a = ldap_next_attribute(trl->ld, e, ber)){ + dprint((9, " %s", a)); + if(strcmp(a, trl->info_used->cnattr) == 0){ + if(!cn) + cn = ldap_get_values(trl->ld, e, a); + + if(cn && !(cn[0] && cn[0][0])){ + ldap_value_free(cn); + cn = NULL; + } + } + else if(strcmp(a, trl->info_used->mailattr) == 0){ + if(!mail) + mail = ldap_get_values(trl->ld, e, a); + } + else if(strcmp(a, "o") == 0){ + if(!org) + org = ldap_get_values(trl->ld, e, a); + } + else if(strcmp(a, "ou") == 0){ + if(!unit) + unit = ldap_get_values(trl->ld, e, a); + } + else if(strcmp(a, "title") == 0){ + if(!title) + title = ldap_get_values(trl->ld, e, a); + } + + our_ldap_memfree(a); + } + + if(!cn){ + for(a = ldap_first_attribute(trl->ld, e, &ber); + a != NULL; + a = ldap_next_attribute(trl->ld, e, ber)){ + + if(strcmp(a, trl->info_used->snattr) == 0){ + if(!sn) + sn = ldap_get_values(trl->ld, e, a); + + if(sn && !(sn[0] && sn[0][0])){ + ldap_value_free(sn); + sn = NULL; + } + } + our_ldap_memfree(a); + } + } + if(ret_cn) + (*ret_cn) = cn; + else if(cn) ldap_value_free(cn); + if(ret_org) + (*ret_org) = org; + else if(org) ldap_value_free(org); + if(ret_unit) + (*ret_unit) = unit; + else if(unit) ldap_value_free(unit); + if(ret_title) + (*ret_title) = title; + else if(title) ldap_value_free(title); + if(ret_mail) + (*ret_mail) = mail; + else if(mail) ldap_value_free(mail); + if(ret_sn) + (*ret_sn) = sn; + else if(sn) ldap_value_free(sn); + + return 0; +} + +WPLDAPRES_S * +free_wpldapres(wpldapr) + WPLDAPRES_S *wpldapr; +{ + WPLDAPRES_S *tmp1, *tmp2; + + for(tmp1 = wpldapr; tmp1; tmp1 = tmp2){ + tmp2 = tmp1->next; + if(tmp1->str) + fs_give((void **)&tmp1->str); + if(tmp1->reslist) + free_ldap_result_list(&tmp1->reslist); + } + fs_give((void **)&wpldapr); + return(NULL); +} +#endif /* ENABLE_LDAP */ diff --git a/web/src/alpined.d/ldap.h b/web/src/alpined.d/ldap.h new file mode 100644 index 00000000..2ada2908 --- /dev/null +++ b/web/src/alpined.d/ldap.h @@ -0,0 +1,48 @@ +/*----------------------------------------------------------------------- + $Id: ldap.h 5 2006-01-04 17:53:54Z hubert $ + -----------------------------------------------------------------------*/ + +/* ======================================================================== + * Copyright 2006-2008 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#ifndef _WEB_ALPINE_LDAP_INCLUDED +#define _WEB_ALPINE_LDAP_INCLUDED + + +#ifdef ENABLE_LDAP + +#include "../../../pith/ldap.h" + +typedef struct wpldapres { + char *str; + LDAP_SERV_RES_S *reslist; + struct wpldapres *next; +} WPLDAPRES_S; + +typedef struct wpldap { + int query_no; + WPLDAPRES_S *ldap_search_list; +} WPLDAP_S; + + +extern WPLDAP_S *wpldap_global; + + +char *peLdapPname(char *, char *); +int peLdapEntryParse(LDAP_SERV_RES_S *, LDAPMessage *, + char ***, char ***, char ***, char ***, + char ***, char ***); +WPLDAPRES_S *free_wpldapres(WPLDAPRES_S *); + +#endif /* ENABLE_LDAP */ + +#endif /* _WEB_ALPINE_LDAP_INCLUDED */ diff --git a/web/src/alpined.d/remote.c b/web/src/alpined.d/remote.c new file mode 100644 index 00000000..3269a978 --- /dev/null +++ b/web/src/alpined.d/remote.c @@ -0,0 +1,78 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: remote.c 101 2006-08-10 22:53:04Z mikes@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" + +#include "../../../pith/remote.h" +#include "../../../pith/msgno.h" +#include "../../../pith/filter.h" +#include "../../../pith/util.h" +#include "../../../pith/debug.h" +#include "../../../pith/osdep/collate.h" + + +/* + * Internal prototypes + */ + +int +rd_prompt_about_forged_remote_data(reason, rd, extra) + int reason; + REMDATA_S *rd; + char *extra; +{ + char tmp[2000]; + char *unknown = "<unknown>"; + char *foldertype, *foldername, *special; + + /* + * Since we're web based the user doesn't have much recourse in the event of one of these + * weird errors, so we just report what happened and forge ahead + */ + + foldertype = (rd && rd->t.i.special_hdr && !strucmp(rd->t.i.special_hdr, REMOTE_ABOOK_SUBTYPE)) + ? "address book" + : (rd && rd->t.i.special_hdr && !strucmp(rd->t.i.special_hdr, REMOTE_PINERC_SUBTYPE)) + ? "configuration" + : "data"; + foldername = (rd && rd->rn) ? rd->rn : unknown; + special = (rd && rd->t.i.special_hdr) ? rd->t.i.special_hdr : unknown; + + dprint((1, "rd_check_out_forged_remote_data: reason: %d, type: $s, name: %s", + reason, foldertype ? foldertype : "?", foldername ? foldername : "?")); + + if(rd && rd->flags & USER_SAID_NO) + return(-1); + + if(reason == -2){ + snprintf(tmp, sizeof(tmp), _("Missing \"%s\" header in remote pinerc"), special); + tmp[sizeof(tmp)-1] = '\0'; + } + else if(reason == -1){ + snprintf(tmp, sizeof(tmp), _("Unexpected \"Received\" header in remote pinerc")); + tmp[sizeof(tmp)-1] = '\0'; + } + else if(reason >= 0){ + snprintf(tmp, sizeof(tmp), _("Unexpected value \"%s: %s\" in remote pinerc"), special, (extra && *extra) ? extra : "?"); + tmp[sizeof(tmp)-1] = '\0'; + } + + rd->flags |= USER_SAID_YES; + return(1); +} diff --git a/web/src/alpined.d/signal.c b/web/src/alpined.d/signal.c new file mode 100644 index 00000000..3bdb7b41 --- /dev/null +++ b/web/src/alpined.d/signal.c @@ -0,0 +1,280 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: signal.c 91 2006-07-28 19:02:07Z mikes@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2008 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" + +#include "../../../pith/conf.h" +#include "../../../pith/status.h" +#include "../../../pith/signal.h" +#include "../../../pith/debug.h" +#include "../../../pith/adrbklib.h" +#include "../../../pith/remote.h" +#include "../../../pith/imap.h" + +#include "alpined.h" +#include "debug.h" + + +static int cleanup_called_from_sig_handler; + +static RETSIGTYPE hup_signal(int); +static RETSIGTYPE term_signal(int); +static RETSIGTYPE auger_in_signal(int); +int fast_clean_up(); +void end_signals(int); +#if defined(DEBUG) && defined(SIGUSR1) && defined(SIGUSR2) +static RETSIGTYPE usr1_signal(int); +static RETSIGTYPE usr2_signal(int); +#endif + + +/*---------------------------------------------------------------------- + Install handlers for all the signals we care to catch + ----------------------------------------------------------------------*/ +void +init_signals(void) +{ + /* prepare for unexpected exit */ + signal(SIGHUP, hup_signal); + signal(SIGTERM, term_signal); + + /* prepare for unforseen problems */ + signal(SIGILL, auger_in_signal); + signal(SIGTRAP, auger_in_signal); +#ifdef SIGEMT + signal(SIGEMT, auger_in_signal); +#endif + signal(SIGBUS, auger_in_signal); + signal(SIGSEGV, auger_in_signal); + signal(SIGSYS, auger_in_signal); + +#if defined(DEBUG) && defined(SIGUSR1) && defined(SIGUSR2) + /* Set up SIGUSR2 to {in,de}crement debug level */ + signal(SIGUSR1, usr1_signal); + signal(SIGUSR2, usr2_signal); +#endif +} + + +/*---------------------------------------------------------------------- + handle hang up signal -- SIGHUP + +Not much to do. Rely on periodic mail file check pointing. + ----------------------------------------------------------------------*/ +static RETSIGTYPE +hup_signal(int sig) +{ + end_signals(1); + cleanup_called_from_sig_handler = 1; + + while(!fast_clean_up()) + sleep(1); + + if(peSocketName) /* clean up unix domain socket */ + (void) unlink(peSocketName); + + exceptional_exit("SIGHUP received", 0); +} + + +/*---------------------------------------------------------------------- + handle terminate signal -- SIGTERM + +Not much to do. Rely on periodic mail file check pointing. + ----------------------------------------------------------------------*/ +static RETSIGTYPE +term_signal(int sig) +{ + end_signals(1); + cleanup_called_from_sig_handler = 1; + + while(!fast_clean_up()) + sleep(1); + + if(peSocketName) /* clean up unix domain socket */ + (void) unlink(peSocketName); + + exceptional_exit("SIGTERM received", 0); +} + + +/*---------------------------------------------------------------------- + Handle signals caused by aborts -- SIGSEGV, SIGILL, etc + +Call panic which cleans up tty modes and then core dumps + ----------------------------------------------------------------------*/ +static RETSIGTYPE +auger_in_signal(int sig) +{ + end_signals(1); + + if(peSocketName) /* clean up unix domain socket */ + (void) unlink(peSocketName); + + snprintf(tmp_20k_buf, SIZEOF_20KBUF, "Abort: signal %d", sig); + panic(tmp_20k_buf); /* clean up and get out */ + exit(-1); /* in case panic doesn't kill us */ +} + + +/*---------------------------------------------------------------------- + Handle cleaning up mail streams and tty modes... +Not much to do. Rely on periodic mail file check pointing. Don't try +cleaning up screen or flushing output since stdout is likely already +gone. To be safe, though, we'll at least restore the original tty mode. +Also delete any remnant _DATAFILE_ from sending-filters. + ----------------------------------------------------------------------*/ +int +fast_clean_up(void) +{ + int i; + MAILSTREAM *m; + + if(ps_global->expunge_in_progress) + return(0); + + /* + * This gets rid of temporary cache files for remote addrbooks. + */ + completely_done_with_adrbks(); + + /* + * This flushes out deferred changes and gets rid of temporary cache + * files for remote config files. + */ + if(ps_global->prc){ + if(ps_global->prc->outstanding_pinerc_changes) + write_pinerc(ps_global, Main, + cleanup_called_from_sig_handler ? WRP_NOUSER : WRP_NONE); + + if(ps_global->prc->rd) + rd_close_remdata(&ps_global->prc->rd); + + free_pinerc_s(&ps_global->prc); + } + + /* as does this */ + if(ps_global->post_prc){ + if(ps_global->post_prc->outstanding_pinerc_changes) + write_pinerc(ps_global, Post, + cleanup_called_from_sig_handler ? WRP_NOUSER : WRP_NONE); + + if(ps_global->post_prc->rd) + rd_close_remdata(&ps_global->post_prc->rd); + + free_pinerc_s(&ps_global->post_prc); + } + + /* + * Can't figure out why this section is inside the ifdef, but no + * harm leaving it that way, I guess. + */ +#if !defined(DOS) && !defined(OS2) + for(i = 0; i < ps_global->s_pool.nstream; i++){ + m = ps_global->s_pool.streams[i]; + if(m && !m->lock) + pine_mail_actually_close(m); + } +#endif /* !DOS */ + + imap_flush_passwd_cache(TRUE); + + if(peSocketName) /* clean up unix domain socket */ + (void) unlink(peSocketName); + + dprint((1, "done with fast_clean_up\n")); + return(1); +} + + + +/*---------------------------------------------------------------------- + Return all signal handling back to normal + ----------------------------------------------------------------------*/ +void +end_signals(int blockem) +{ +#ifndef SIG_ERR +#define SIG_ERR (RETSIGTYPE (*)())-1 +#endif + if(signal(SIGILL, blockem ? SIG_IGN : SIG_DFL) != SIG_ERR){ + signal(SIGTRAP, blockem ? SIG_IGN : SIG_DFL); +#ifdef SIGEMT + signal(SIGEMT, blockem ? SIG_IGN : SIG_DFL); +#endif + signal(SIGBUS, blockem ? SIG_IGN : SIG_DFL); + signal(SIGSEGV, blockem ? SIG_IGN : SIG_DFL); + signal(SIGSYS, blockem ? SIG_IGN : SIG_DFL); + signal(SIGHUP, blockem ? SIG_IGN : SIG_DFL); + signal(SIGTERM, blockem ? SIG_IGN : SIG_DFL); + signal(SIGINT, blockem ? SIG_IGN : SIG_DFL); + } +} + + +#if defined(DEBUG) && defined(SIGUSR1) && defined(SIGUSR2) +/*---------------------------------------------------------------------- + handle -- SIGUSR1 + + Increment debug level + ----------------------------------------------------------------------*/ +static RETSIGTYPE +usr1_signal(int sig) +{ + if(debug < 11) + debug++; + + setup_imap_debug(); + + dprint((SYSDBG_INFO, "Debug level now %d", debug)); +} + +/*---------------------------------------------------------------------- + handle -- SIGUSR2 + + Decrement debug level + ----------------------------------------------------------------------*/ +static RETSIGTYPE +usr2_signal(int sig) +{ + if(debug > 0) + debug--; + + setup_imap_debug(); + + dprint((SYSDBG_INFO, "Debug level now %d", debug)); + +} +#endif + + +/* + * Command interrupt support. + */ +int +intr_handling_on(void) +{ + return 0; +} + + +void +intr_handling_off(void) +{ +} diff --git a/web/src/alpined.d/signal.h b/web/src/alpined.d/signal.h new file mode 100644 index 00000000..3ae6bd50 --- /dev/null +++ b/web/src/alpined.d/signal.h @@ -0,0 +1,15 @@ +/*----------------------------------------------------------------------- + $Id: signal.h 82 2006-07-12 23:36:59Z mikes@u.washington.edu $ + -----------------------------------------------------------------------*/ + +#ifndef _WEB_ALPINE_SIGNAL_INCLUDED +#define _WEB_ALPINE_SIGNAL_INCLUDED + + +/* exported protoypes */ +void init_signals(void); + + + + +#endif /* _WEB_ALPINE_SIGNAL_INCLUDED */ diff --git a/web/src/alpined.d/status.c b/web/src/alpined.d/status.c new file mode 100644 index 00000000..3c546d6f --- /dev/null +++ b/web/src/alpined.d/status.c @@ -0,0 +1,78 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: status.c 1142 2008-08-13 17:22:21Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +/*====================================================================== + status.c + Functions that manage the status line (third from the bottom) + - put messages on the queue to be displayed + - display messages on the queue with timers + - check queue to figure out next timeout + - prompt for yes/no type of questions + ====*/ + +#include <system.h> +#include <general.h> + +#include "../../../pith/status.h" +#include "../../../pith/helptext.h" +#include "../../../pith/debug.h" +#include "../../../pith/string.h" + +#include "alpined.h" + + + + +/*---------------------------------------------------------------------- + Put a message for the status line on the queue + ----------*/ +void +q_status_message(int flags, int min_time, int max_time, char *message) +{ + if(!(flags & SM_INFO)) + sml_addmsg(0, message); +} + + +/*---------------------------------------------------------------------- + Time remaining for current message's minimum display + ----*/ +int +status_message_remaining(void) +{ + return(0); +} + + + +/*---------------------------------------------------------------------- + Update status line, clearing or displaying a message +----------------------------------------------------------------------*/ +int +display_message(UCS command) +{ + return(0); +} + + + +/*---------------------------------------------------------------------- + Display all the messages on the queue as quickly as possible + ----*/ +void +flush_status_messages(int skip_last_pause) +{ +} diff --git a/web/src/alpined.d/stubs.c b/web/src/alpined.d/stubs.c new file mode 100644 index 00000000..299c7c81 --- /dev/null +++ b/web/src/alpined.d/stubs.c @@ -0,0 +1,169 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: stubs.c 769 2007-10-24 00:15:40Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "../../../c-client/c-client.h" + +#include "../../../pith/takeaddr.h" +#include "../../../pith/ldap.h" +#include "../../../pith/debug.h" +#include "../../../pith/osdep/coredump.h" + +#include "alpined.h" + + +/* let cleanup calls know we're screwed */ +static int in_panic = 0; + +/* input timeout */ +static int input_timeout = 0; + +/* time of last user-initiated newmail check */ +static time_t time_of_input; + + +void +peMarkInputTime(void) +{ + time_of_input = time((time_t *)0); +} + + +/********* ../../../pith/newmail.c stub **********/ +time_t +time_of_last_input() +{ + return(time_of_input); +} + + +/********* ../../../pith/conf.c stub **********/ +int +set_input_timeout(t) + int t; +{ + int old_t = input_timeout; + + input_timeout = t; + return(old_t); +} + + +int +get_input_timeout() +{ + return(input_timeout); +} + + +int +unexpected_pinerc_change() +{ + dprint((1, "Unexpected pinerc change")); + return(0); /* always overwrite */ +} + +/********* ../../../pith/mailcap.c stub **********/ +int +exec_mailcap_test_cmd(cmd) + char *cmd; +{ + return(-1); /* never succeeds on web server */ +} + + +/****** various other stuff ******/ +/*---------------------------------------------------------------------- + panic - call on detected programmatic errors to exit pine + + Args: message -- message to record in debug file and to be printed for user + + Result: The various tty modes are restored + If debugging is active a core dump will be generated + Exits Pine + + This is also called from imap routines and fs_get and fs_resize. + ----*/ +void +panic(message) + char *message; +{ + in_panic = 1; + + syslog(LOG_ERR, message); /* may not work, but try */ + +#if 0 + if(ps_global) + peDestroyUserContext(&ps_global); +#endif + +#ifdef DEBUG + if(debug > 1) + coredump(); /*--- If we're debugging get a core dump --*/ +#endif + + exit(-1); + fatal("ffo"); /* BUG -- hack to get fatal out of library in right order*/ +} + + +/*---------------------------------------------------------------------- + panicking - called to test whether we're sunk + + Args: none + + ----*/ +int +panicking() +{ + return(in_panic); +} + + +/*---------------------------------------------------------------------- + exceptional_exit - called to exit under unusual conditions (with no core) + + Args: message -- message to record in debug file and to be printed for user + ev -- exit value + + ----*/ +void +exceptional_exit(message, ev) + char *message; + int ev; +{ + syslog(LOG_ALERT, message); + exit(ev); +} + + +/*---------------------------------------------------------------------- + write argument error to the display... + + Args: none + + Result: prints help messages + ----------------------------------------------------------------------*/ +void +display_args_err(s, a, err) + char *s; + char **a; + int err; +{ + syslog(LOG_INFO, "Arg Error: %s", s); +} diff --git a/web/src/alpined.d/stubs.h b/web/src/alpined.d/stubs.h new file mode 100644 index 00000000..8128a4aa --- /dev/null +++ b/web/src/alpined.d/stubs.h @@ -0,0 +1,25 @@ +/*----------------------------------------------------------------------- + $Id: stubs.h 130 2006-09-22 04:39:36Z mikes@u.washington.edu $ + -----------------------------------------------------------------------*/ + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#ifndef _WEB_ALPINE_STUBS_INCLUDED +#define _WEB_ALPINE_STUBS_INCLUDED + + +/* exported prototypes */ +void peMarkInputTime(void); + + +#endif /* _WEB_ALPINE_STUBS_INCLUDED */ diff --git a/web/src/alpined.d/wpcomm.c b/web/src/alpined.d/wpcomm.c new file mode 100644 index 00000000..b9f17073 --- /dev/null +++ b/web/src/alpined.d/wpcomm.c @@ -0,0 +1,197 @@ +#if !defined(lint) && !defined(DOS) +static char rcsid[] = "$Id: wpcomm.c 1266 2009-07-14 18:39:12Z hubert@u.washington.edu $"; +#endif + +/* ======================================================================== + * Copyright 2006-2007 University of Washington + * + * 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 + * + * ======================================================================== + */ + + +#include <string.h> +#include <tcl.h> +#include <unistd.h> +#include <errno.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <sys/un.h> + + +#define VERSION "0.1" + +#define READBUF 4096 +#define RESULT_MAX 16 + +int append_rbuf(char *, char *, int); +int WPSendCmd(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []); + + +/* + * WPComm_Init - entry point for Web Alpine servlet communications. + * + * returns: TCL defined values for success or failure + * + */ + +int +Wpcomm_Init(Tcl_Interp *interp) +{ + if(Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL + && TCL_VERSION[0] == '7' + && Tcl_PkgRequire(interp, "Tcl", "8.0", 0) == NULL) + return TCL_ERROR; + + if(Tcl_PkgProvide(interp, "WPComm", VERSION) != TCL_OK) + return TCL_ERROR; + + Tcl_CreateObjCommand(interp, "WPSend", WPSendCmd, + (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); + + return TCL_OK; +} + + + +/* + * WPSendCmd - establish communication with the specified device, + * send the given command and return results to caller. + * + */ +int +WPSendCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + char buf[READBUF], lbuf[32], *errbuf = NULL, rbuf[RESULT_MAX], *fname, *cmd; + int s, i, n, b, rs, rv = TCL_ERROR, wlen; + struct sockaddr_un name; + Tcl_Obj *lObj; + + errno = 0; + + if(objc == 3 + && (fname = Tcl_GetStringFromObj(objv[1], NULL)) + && (cmd = Tcl_GetByteArrayFromObj(objv[2], &wlen))){ + if((s = socket(AF_UNIX, SOCK_STREAM, 0)) == -1){ + snprintf(errbuf = buf, sizeof(buf), "WPC: socket: %s", strerror(errno)); + } + else{ + name.sun_family = AF_UNIX; + strcpy(name.sun_path, fname); + + if(connect(s, (struct sockaddr *) &name, sizeof(name)) == -1){ + if(errno == ECONNREFUSED || errno == ENOENT) + snprintf(errbuf = buf, sizeof(buf), "WPC: Inactive session"); + else + snprintf(errbuf = buf, sizeof(buf), "WPC: connect: %s", strerror(errno)); + } + else if((n = wlen) != 0){ + if(n < 0x7fffffff){ + snprintf(lbuf, sizeof(lbuf), "%d\n", n); + i = strlen(lbuf); + if(write(s, lbuf, i) == i){ + for(i = 0; n; n = n - i) + if((i = write(s, cmd + i, n)) == -1){ + snprintf(errbuf = buf, sizeof(buf), "WPC: write: %s", strerror(errno)); + break; + } + } + else + snprintf(errbuf = buf, sizeof(buf), "Can't write command length."); + } + else + snprintf(errbuf = buf, sizeof(buf), "Command too long."); + + rbuf[0] = '\0'; + rs = 0; + lObj = NULL; + while((n = read(s, buf, READBUF)) > 0) + if(!errbuf){ + for(i = b = 0; i < n; i++) + if(buf[i] == '\n'){ + if(rs){ + Tcl_AppendToObj(Tcl_GetObjResult(interp), &buf[b], i - b); + Tcl_AppendToObj(Tcl_GetObjResult(interp), " ", 1); + } + else{ + rs = 1; + if(append_rbuf(rbuf, &buf[b], i - b) < 0) + snprintf(errbuf = buf, sizeof(buf), "WPC: Response Code Overrun"); + else if(!strcasecmp(rbuf,"OK")) + rv = TCL_OK; + else if(!strcasecmp(rbuf,"ERROR")) + rv = TCL_ERROR; + else if(!strcasecmp(rbuf,"BREAK")) + rv = TCL_BREAK; + else if(!strcasecmp(rbuf,"RETURN")) + rv = TCL_RETURN; + else + snprintf(errbuf = buf, sizeof(buf), "WPC: Unexpected response: %s", rbuf); + } + + b = i + 1; + } + + if(i - b > 0){ + if(rs) + Tcl_AppendToObj(Tcl_GetObjResult(interp), &buf[b], i - b); + else if(append_rbuf(rbuf, &buf[b], i - b) < 0) + snprintf(errbuf = buf, sizeof(buf), "WPC: Response Code Overrun"); + } + } + + if(!errbuf){ + if(n < 0){ + snprintf(errbuf = buf, sizeof(buf), "WPC: read: %s", strerror(errno)); + rv = TCL_ERROR; + } + else if(!rs){ + if(n == 0) + snprintf(errbuf = buf, sizeof(buf), "WPC: Server connection closed (%d)", errno); + else + snprintf(errbuf = buf, sizeof(buf), "WPC: Invalid Response to \"%.*s\" (len %d) (%d): %.*s", 12, cmd, wlen, errno, RESULT_MAX, rbuf); + + rv = TCL_ERROR; + } + else if(rv == TCL_ERROR){ + char *s = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL); + if(!(s && *s)) + snprintf(errbuf = buf, sizeof(buf), "WPC: Empty ERROR Response"); + } + } + } + + close(s); + } + } + else + snprintf(errbuf = buf, sizeof(buf), "Usage: %s path cmd", Tcl_GetStringFromObj(objv[0], NULL)); + + if(errbuf) + Tcl_SetResult(interp, errbuf, TCL_VOLATILE); + + return(rv); +} + + +int +append_rbuf(char *rbuf, char *b, int l) +{ + int i; + + if(l + (i = strlen(rbuf)) > RESULT_MAX) + return(-1); + + rbuf += i; + + while(l--) + *rbuf++ = *b++; + + *rbuf = '\0'; + return(0); +} diff --git a/web/src/cgi.tcl-1.10/HISTORY b/web/src/cgi.tcl-1.10/HISTORY new file mode 100644 index 00000000..3fc80020 --- /dev/null +++ b/web/src/cgi.tcl-1.10/HISTORY @@ -0,0 +1,644 @@ +This is the HISTORY file for cgi.tcl. + +Date Version Description +------- ------- ------------------------------------------------------ +5/1/05 1.10.0 Odd Arne Jensen <odd@bibsyst.xno> observed that <input>-related + tags were producing </input> which is forbidden by the HTML + spec. We agreed to go with .../> for max compatibility with + both HTML and XHTML. + + Noticed hackers submitting filenames with leading hyphens to + display to do interesting things. It did fail gracefully + fortunately but it shouldn't fail at all. Added -- to switch. + + Evan Mezeske <emezeske@enflex.xnet> recommended settable limits + on file uploads to avoid denial-of-service attacks. Added + cgi_file_limit. + +12/14/05 1.9.0 Tore Morkemo noted backward test in cgi_noscript used puts + instead of cgi_puts. + + Aravindo Wingeier <wingeier@glue.ch> provided patches to choose + an encoding or use UTF-8 encoding by default. + + Rolf Ade <pointsmen@gmx.xnet> noted an initialization proc + would be useful for things like tclhttpd. + + Modified display.cgi to deal more gracefully with people + experimenting with tildes. + + De Clarke noted cgi_input failed if whitespace appeared in a + client filename. Due to assumption that Content-Disposition + line would be a proper list. + + De also noted that lynx simply wasn't providing quotes in + multipart input variable names. Relaxed code to accept that. + + De also noted that the binary file upload wasn't working in + pre-Tcl 8.1 but neither of us were interested in spending the + time to find out why. Unless someone bothers to figure it, for + now, I'm just dropping support for such old versions. + + Due to DoC policy, changed cookie example from persistent to + non-persistent. + + Added utf.cgi example to demonstrate UTF works for + mel@redolive.com. + +10/16/02 1.8.0 To accomodate open-ended forms in echo, modified cgi_input so + that it accepts multiple values even in variables that don't + end with "List". This opens a possible ambiguity (see + documentation) but only one that would've existed before had + the diagnostic not prevented it. + + Added example: echo.cgi + + Added cgierror anchor to cgi_eval. + + Tian-Hsiang Huang <xiang@phys.ncku.edu.tw> noted bug in testing + for error of passwd.cgi example. + +4/27/02 1.7.0 David Kuehling <dvdkhlng@gmx.de> noted that cgi_content_type + needed to protect args in call to cgi_http_head. + +4/15/02 1.6.1 Darren New fixed my attempt at 1.6.0! + +4/15/02 1.6.0 Darren New <dnew@san.rr.com> noted that quote_url needed to + translate +. + +3/16/02 1.6.0 Added test for checked=bool to radio/checkbox to avoid having + user have to do "eval ... [expr ...?"checked":""]" nonsense. + + Added version.cgi script to make it easier for people to figure + out whether examples on NIST server are using the same version + of cgi.tcl that they're using. + + Tore Morkemo noted backward test in cgi_refresh. + +9/19/01 1.5.0 De Clarke noted that file upload broke with Opera. Problem + was lack of a \r at the end of the input file. At the same + time protected regexp-specials in the boundary string. + Both of were due to unusual but legal interpretations. + + Added HELO interaction to smtp dialogue. + + Jonathan Lennox <lennox@cs.columbia.edu> provided fix for + finding sendmail on BSD 4.4 systems. + + Modified cgi_html and _start to support optional attributes. + + Extended auto-attr quoting for XHTML support. + Added end tags for XHTML support. + + Added cgi_link_url/label per John Koontz and rewrote cgi_link + to accomodate them. Also added his cgi_button_link + temporarily. Will experiment with this to test merit. + +11/3/00 1.4.3 Removed HTML formatted manual. It lags the text version and + just caused more confusion than it's worth. + +11/2/00 1.4.2 John Koontz observed that the versions between home page and + package didn't match. Added version.in to fix this once and + for all. + +10/19/00 1.4.1 Carlos Vidal <carlos@tarkus.se> fixed cgi_cookie_get -all. + + Anton Osennikov <ant@ccl.ru> provided patch to propagate + errorCode back through cgi_body. + + Fixed display_in_frame to allow app_body_end to execute. + +6/14/00 1.4.0 Tomas Soucek requested a mechanism for saving content-type + from file uploads. Seemed appropriate to do this by renaming + cgi_import_filename to ..._file and adding -type flag. + + Petrus Vloet noted vote.cnt missing from distrib. He also + noted getting warnings regarding missing newlines. + +5/19/00 1.3.0 Changed many cgi_puts to cgi_put in hopes of addressing more + of Zygo's 5/9/00 complaint (i.e., same problem in tables). + +5/9/00 1.2.2 Zygo Blaxell <zblaxell@feedme.hungrycats.org> provided signif. + cgi_input regexp speedup for long x=y-style values. He also + noted that some browsers are sensitive to leading/following + \n's in textarea and provided a patch to avoid adding them in + the first place. + + James Ward <jew@rincon.com> noted absence of pkgIndex.tcl + (presumably due to really old Tcl) broke installation. Fixed + pkgcreate to create stub file to allow Make to complete. + + Robin Lauren <robin.lauren@novostore.com> contributed the doc + in HTML form. Really need to automate this now, sigh. + + Jan.Vlcek@sasprg.cz observed that converting %XX to \u00XX + and then using subst is only good for us-ascii and corrupts + iso8859-1, iso8859-2, etc. He provided a patch for + cgi_unquote_input. + + Ross Mohn <rpmohn@waxandwane.com> corrected syntax error in + cgi_span and made <hr> handle width= better. + + Tore Morkemo provided a patch to his prior patch for cgi_eval. + + Asari Hirotsugu <asari@math.uiuc.edu> provided additional + installation advice for Mac. + +12/27/99 1.2.1 Tore Morkemo noted expires=never value of 9999 inappropriate + as Netscape ignores anything beyond mid-January 2038. + + Tore also provided patch for cgi_eval when running inside of + a proc. + +12/20/99 1.2.0 Keith Lea <keith@cs.oswego.edu> noted 2-digit years as per + RFC2109. Despite RFC, Netscape now accepts 4-digit years. + Some browsers won't like this but it hardly matters anyway + since they'll do the wrong thing on old 2-digit years come + Y2K anyway. + + Petrus Vloet noted example/nistguest missing from distrib. + +12/18/99 1.1.0 Tomas Soucek" <tomas.soucek@sasprg.cz> noted cgi_input was + adding eol characters to uploaded files if they didn't + contain them. Fixed this and also enhanced file upload + example so that it could do both cat/od and also warn when + Tcl couldn't do binary upload. + + Added braces around unprotected expressions. + + Added check to unimail example for HTTP_REFERER. + + Petrus Vloet requested Makefile install example data files. + + Added img.cgi example and modified frame example so it accepts + "example=whatever" so that I can post URLs that go right to a + particular example and have it framed. + +9/12/99 1.0.0 Bumped version to 1 to pacify management. + + Jeffrey Hobbs rewrote cgi_unquote_input to take advantage of + 8.2 features. 300% speed improvement! + +7/16/99 0.8.1 Douglas Ridgway provided mod to make cgi_image_button handle + optional args. + + Made code use straight cgi_input_multipart if on Tcl 8.1. + + Jeffrey Hobbs provided cgi_unquote_input that works better for + 8.1. + + Petrus Vloet <petrus.vloet@siemens.at> requested sample data + files for examples that need them; ability to change example + install destination. + +2/22/98 0.8.0 Tore Morkemo noted that cookied_encode needed to convert \n's. + + Added example of how to produce a raw image. + + Upon suggestion of Jean-Yves Terrien + <jeanyves.terrien@cnet.francetelecom.fr> experimented with + version of cgi_puts that would indent HTML for readability. + Code looked something like this: + + proc NEW_cgi_puts {args} { + global _cgi + + if {$_cgi(preformatted)} { + eval puts $args + } else { + set indent_full [format "%-$_cgi(indent)s" ""] + + # if we're at the beginning of the line, use a full indent + if {$_cgi(bol)} { + set indent $indent_full + } else { + set indent "" + } + + set tail [lindex $args end] + set output "" + + # loop through output, breaking into \n-delimited lines + while {[string length $tail]} { + # this regexp will always match + regexp "^(\[^\n]*)(\n?)(.*)" $tail dummy line nl tail + append output $indent$line + if {$nl == ""} { + set _cgi(bol) 0 + break + } + append output \n + set $_cgi(bol) 1 + set indent $indent_full + } + + # handle optional -nonewline + if {[llength $args] == 1} { + append output \n + set _cgi(bol) 1 + } + puts -nonewline $output + } + } + + Unfortunately, some tags are whitespace-sensitive such as + textarea. If you do cgi_buffer {p;textarea ...} how can cgi_ + puts possibly know that part of the buffer shouldn't be + modified? A user-level flag could be added to avoid corrupting + the HTML but the source display could never be made perfect. + Considering that programmers would have to be aware of these + issues (via flags or options) and the payoff is so minute, it's + just not worth it. I think. As an aside, does regexp on every + line of output cost too much? I doubt anyone would notice but + it's something to ponder. + + Renamed internal cgi routines with _ prefix. + + Matthew Levine <mlevine@cisco.com> observed that cgi_eval + did a #0 eval but a plain eval is more appropriate. + + Anthony Martin <anthony.n.martin@marconicomms.com> noted that + cgi_cgi_set needs to rewrite #. + + Removed cgi_http_get. + + Added registry support to uid_check. + + Eddy Kim <ehkim@ibm.net> noted bug in doc regarding cgi_puts. + + cgi_file_button now verifies that form has correct encoding. + + Fixed doc to reflect more precise use of selected_if_equal. + + Ralph Billes <echo@iinet.net.au> fixed bug in cgi_uid_check. + + Began adding stylesheet support. Made cgi_stylesheet and + cgi_span. Not yet documented. + + Douglas Ridgway <ridgway@gmcl.com> noted that lynx doesn't + respond correctly to multipart form requests. Added check and + diagnostic. Doug also found a bug in the multipart_binary + because I forgot to turn off the timeout. + + Stefan Hornburg <racke@gundel.han.de> writes: + "I've made a RPM package for cgi.tcl. Available at: + http://www.han.de/~racke/linuxia/noarch/cgi.tcl-0.7.5-1.noarch.rpm + http://www.han.de/~racke/linuxia/srpms/cgi.tcl-0.7.5-1.src.rpm + http://www.han.de/~racke/linuxia/specs/cgitcl.spec + and hopefully soon at Redhat/Contrib." + He also noted a missing example: download.cgi. + +6/25/98 0.7.5 Henk-Jan Kooiman <hjk@cable.a2000.nl> fixed bugs in + cgi_relationship and also provided MacOS instructions. + + Martin Schwenke <Martin.Schwenke@cs.anu.edu.au> and Ryan + McCormack <ryanm@cam.nist.gov> both reported textarea lost + newlines when using multipart. + + At urging of Robert Baptista <Robert.Baptista@vanmail.amd.com>, + began adding HTML 4.0 support. Changed cgi_center to avoid + <center>. + + Added download.cgi example. + + John Koontz noted example in file upload documentation still + used deprecated flags. + + 0.7.4 Fixed bug in cgi_refresh. + + Added alt attr to cgi_area. + + Added vote.cgi example. + + Localized some init-time vars to avoid stomping on user's. + + Made cgi_quote_url also quote {"} so URLs. This isn't strictly + necessary, but since URLs will usually be embedded inside HTML, + this simplifies embedding and doesn't hurt anything else. + + Tom Poindexter <tpoindex@nyx.net> added cgi_suffix. + + Removed reference to sendmail from documentation since sendmail + is no longer required. + +12/16/97 0.7.3 Provided SMTP dialogue to replace call to sendmail and removed + all other UNIXisms (exec and direct refs to file system). + + Rewrote LUHN proc in credit card example to work correctly! + + Added type tag support to cgi_relationship. + +11/10/97 0.7.2 Massaged documentation to describe installation on W95/NT.... + Made example.tcl and date.cgi portable. + + Added rm.cgi example. + + Beat Jucker <bj@glue.ch> fixed syntax error in oratcl.cgi + example. + +10/20/97 0.7.1 Fixed cgi_option so that value strings are quoted. Also made + selected_if_equal check value rather than visible string. + + Tore Morkemo <tore@bibsyst.no> provided patch so that cgi_set + translated "=". + + Fixed buffering bug in push example. + + Added credit card example. + + Paul Saxe <saxe@connectnet.com> noted cgi_embed broke due to + unprotected regexp pattern beginning with -. + + +8/22/97 0.7.0 INCOMPATIBILITY: cgi_anchor_name now returns the anchor tag + instead of printing it. Only after some experience do I see + now that anchors always need to be embedded in something else + for accuracy in the jump. + + Josh Lubell noted that file upload failed if there was + whitespace in filename. Problem was that filename-encoding + doesn't encode whitespace or otherwise protect it. There is + no perfect fix since the spec doesn't explain how to know when + fields end. The implication is that they are delimited by + " however an embedded " is not encoded either! For now, assume + filename field is at end of line. This isn't the greatest idea + for it allows future encoding changes to break the code, but + for now it will pick up all filenames including really weird + ones like 'a b"; foo="bar' that would otherwise appear to be + additional fields! + + Jon Leech <leech@cs.unc.edu> provided code to allow user to + temporarily use existing links but displaying differently. + + Alvaro Santamaria <alvaro.santamaria@stest.ch> noted that I + forgot to include kill.cgi and oratcl.cgi in example directory. + + John Koontz noted cgi_buffer's defn of cgi_puts assumed "usual" + newline generation - interacted badly inside of <pre> tags. + Added cgi_buffer_nl to control this. + + James Ward requested option to change ".cgi" suffix. Added + -suffix to cgi_cgi. + + Someone's browser (Mozilla/4.01 [en] (WinNT; I) via proxy + gateway CERN-HTTPD/3.0 libwww/2.17) supplied a boundary defn + but no actual boundary. Added test to + cgi_input_multipart_binary. + + James Ward found cgi_import_list didn't return List vars. + + Diagnostics about broken multipart responses are now returned + to users (who are using old browsers). + + Changed nbsp to numeric equiv to support NS2. + + Made cgi_debug always return old value. + +6/4/97 0.6.6 Added cgi_buffer - force commands that normally generate output + to return strings. + + Deprecated -local & -remote flags to import_filename. Added + support for -server & -client which are less confusing. + + Improved examples in numerous ways. + + James Ward <jew@mcmuse.mc.maricopa.edu> noted I forgot to + document cgi_img. + + Upgraded cgi_quote as per HTML 3.2 + + Mark Diekhans <markd@Grizzly.COM> provided bug fix to cgi_tr + and optional level arg to all uplevel/upvar calls to avoid + misinterpretation. Also added cgi_th. + + Appears that NS3.0 has a bug wrt multipart. It won't display + last fragment on page unless followed by a <br> (even if it + sees </body>). Added cgi_br to multipart support code. + +5/26/97 0.6.5 Added server-push example which required mods to cgi_title + (bug fix actually), cgi_head, and related code to detect and + handle multipart mime type. + + Added HTTP_HOST to list of things reported_HOST during errors. + + Looks like MS IE can generate cookies without an "=val" part. + + Added Oratcl example. + + Documented cgi_url. + + Fixed search for Tcl executable when look in Tcl's srcdir. + + Added support for detection/reporting of client errors. For + now this means missing CONTENT_LENGTH. + + Created cgi_redirect and deprecated cgi_location. cgi_redirect + is better named and more functional. Added cgi_status. + + Modified unimail example so that it shows diagnostics about + form problems to client - doesn't make sense to send them to + unimail admin. + + Improved form-tour in various ways including making a backend + that actually reports value. + + Fixed bug in textvar that caused args to be generated twice. + +4/8/97 0.6.4 John LoVerso fixed regsub quote bug in cgi_quote_url. Fixed + similar bug cgi_cgi_set. + + Most general path cookies were being returned. Changed to most + specific and added -all to cookie_get so that all values could + be retrieved. Added cookie support to passwd example since + that's a very reasonable use of it. + +4/7/97 0.6.3 John LoVerso fixed bugs in cgi_meta and cgi_map. + + INCOMPATIBILITY: cgi_quote_url was inappropriate for non-cgi + urls. cgi_cgi and cgi_cgi_set should now be used for building + GET-style cgi urls. + + Forgot to switch to cgi.tcl.in in distribution. + +3/28/97 0.6.2 Made cgi.tcl.in autohandle embedded version number (see 0.6.1). + + Fixed display.cgi to prevent display of "." or ".." or "". + + Added cgi.tcl version to diagnostics. + Fixed diagnostics to correctly print input. (Totally missing!) + + John Koontz noted extra \r\n at end of uploaded text files. + +3/24/97 0.6.1 Updated package provide version. (Gotta automate this!) + +3/20/97 0.6.0 Added kill.cgi example to kill/suspend runaway CGI processes. + + Modified passwd.cgi example to quote shell arg. + + Kevin.Christian requested hook for defining doctypes. + + John Robert LoVerso <john@loverso.southborough.ma.us> provided + fixes to allow array-style variables names to be rewritten by + cgi_input. Parens had been left with embedded %s substituted. + My research indicates cookies have similar problems but file- + style encoding does not. + + Josh Lubell found bug in binary upload that would drop \r\n + and \r*. + +2/28/97 0.5.5 Combined many regexps that had parameterizably-common actions. + The old regexps had some bugs in them, so it's a good thing. + + M. Katherine Pagoaga <pagoaga@boulder.nist.gov> and John + Koontz <koontz@boulder.nist.gov> noted cgi_uid_check used + whoami which isn't very portable. Switched to "who am i". + Its output isn't very portable but at least its existence is! + + Removed default call to cgi_uid_check. It's my impression that + most people turn this off anyway. If you want it back, just + call it yourself. + + Added cgi_import_filename to guarantee that a filename really + did come from an upload. This removes the security check that + the user was responsible for - and which I forgot in the + upload examples! + + Rolf Ade <rolf@storz.de> noted that configure could look for + tcl executable in a few more locations. + +2/26/97 0.5.4 Backed out type=text from 0.4.4. This ruined type=password. + If people demand, I'll make the code put in type=text but I now + regret the detour. + + Made cgi_import_list return variables in order originally + appearing in form. + +2/24/97 0.5.3 Added tr/td as shortcut for simple table rows. + + Made cookie code look in COOKIE (O'Reilly's web server uses + that instead of HTTP_COOKIE). + + Kevin.Christian@symbio.com requested warning when form + incorrectly uses select without "List" suffix. Also provided + more obvious diagnostics when applying cgi_import* to non- + existent variable. At same time, I also noticed bug in + cgi_import_cookie* preventing it from seeing user variables. + + Forgot to have cgi_root return root with no args. + +2/11/97 0.5.2 Josh Lubell found binary upload broke, due to one send missing + "--" protection. + + Massaged home page so that it works more intelligently with + frames. Massaged examples for both function and appearance. + +2/10/97 0.5.1 Fixed display of validate example. + + Added cgi_unbreakable_string so that it returns a string. + Compare with cgi_unbreakable. + + Added cgi_javascript and noscript. javascript is like script + but does the javascript-compatible hiding of <script> tags for + older browsers. Added some javascript examples. Added support + for java event types. Netscape documentation is very unclear + as to which tags support which attributions - so I guessed a + lot! + +2/4/97 0.5.0 Added cgi_body_args to make it easier to share and change body + attributes. + + Fixed bug in cookie encoder that caused double %-expansion. + + INCOMPATIBILITY: Modified cgi_preformatted to evaluate last + argument. More flexible this way. Since <pre> forces line + breaks, it's not like inline formatting commands. + Removed cgi_code since it used the xmp tag which is gone. + See documentation for workaround. + + INCOMPATIBILITY: Changed cgi_division to take a command list + rather than a string. + + Added cgi_nl for inline breaks. (Compare with cgi_br.) + +2/3/97 0.4.9 Added support for package loading, now you just say: + "package require cgi" + + Added/modified examples so that they could be put up on + web servers. + + Added support to suppress binary upload when using Expect. + +1/31/97 0.4.8 Andreas Kupries <a.kupries@westend.com> needed dynamic control + of ouput. Added user-defineable cgi_puts. + + Josh Lubell <lubell@cme.nist.gov> reported binary file upload + was losing chars on large files. Fixed. + + Fixed cgi_input to understand REQUEST_METHOD == HEAD should + set input to "". + +1/13/97 0.4.7 Braces in password script was wrong. + + Simplified command aliasing mechanism. + + Add some more bulletproofing to catch broken boundary defns... + + Evidentally QUERY_STRING doesn't have to be set even with GET. + CGI spec is vague enough to permit this. + +12/16/96 0.4.6 Giorgetti Federico <gio@egeo.unipg.it> noted text file upload + wasn't working - forgot "_binary" on new upload proc name. + +12/10/96 0.4.5 Added support for binary file upload if using Expect extension. + + Removed check for missing filenames in file upload. This + can evidentally happen. It is now the programmer's + reptysponsibility to check for the length if null filenames are + unwanted. + + Created HTML home page for cgi.tcl. + +11/26/96 0.4.4 Added type=text for pedantic html checkers. + Bob Lipman noted new if_equal handlers used name instead of + value. + +10/24/96 0.4.3 Forgot global _cgi decls in cgi_refresh and some other procs. + + Bob Lipman noted cgi_radio_button needs checked_if_equal. + Added that and same to cgi_checkbox. + +10/15/96 0.4.2 Remove line-delimiters in non-file elements in multipart enc. + + Added support for additional args to cgi_file_button. + +9/19/96 0.4.1 Bob Lipman noted cookie containing = could not be imported. + + Fixed examples to reference .4 source. + +9/9/96 0.4.0 Added cgi_error_occurred. + In multipart handler, added test for "--" because some + servers(?) don't provide explicit eof, but just hang. + Bugs in close_procs support. + Added auto-htmlquoting to cgi_option. + Removed auto-quoting in cgi_cgi. + Made cgi_root also return root if no arg. + Messed up quoting in cgi_anchor_name and cgi_applet. + cgi_parray was missing <xmp> tag. How odd. + +8/12/96 0.3.5 Mark Pahlavan <mark@vestek.com> provided new cgi_caption defn + after noting that it must allow executable code. + + File upload broke in Tcl 7.5 due to auto-eol translation + +6/19/96 0.3.4 Mark Harrison <mharriso@spdmail.spd.dsccc.com> noted ref to + obsolete cgi_uid_ignore. + +6/19/96 0.3.3 Was wrongly cookie-encoding cookie expiration. cgi_imglink + was confused. Thanks again, Bob. + +6/17/96 0.3.2 Reports from Bob Lipman <lipman@cam.nist.gov> about bad + tables and missing </head>. Fixed. + +6/13/96 0.3.1 Added ";" to &-escapes. Fixed bugs in cgi_unquote_input. + Added cgi_embed. Added doc directory with ref manual. + diff --git a/web/src/cgi.tcl-1.10/INSTALL b/web/src/cgi.tcl-1.10/INSTALL new file mode 100644 index 00000000..4a7f8a76 --- /dev/null +++ b/web/src/cgi.tcl-1.10/INSTALL @@ -0,0 +1,96 @@ +This file is INSTALL. It contains installation instructions for cgi.tcl. + +If you do not have Tcl, get it (the README explains how) and install +it. The rest of these instructions assume that you have Tcl +installed. + +-------------------- +Installation +-------------------- + +By default, the Tcl source directory is assumed to be in the same +directory as the cgi.tcl source directory. For example, in this +listing, cgi.tcl and Tcl are both stored in /usr/local/src: + + /usr/local/src/tcl7.5 (actual version may be different) + /usr/local/src/cgi.tcl-1.0 (actual version may be different) + +If Tcl is stored elsewhere, the easiest way to deal with this is to +create a symbolic link to its real directory. For example, from the +cgi.tcl directory, type: + + ln -s /some/where/else/src/tcl7.5 .. + +Run "./configure". This will generate a Makefile (from a prototype +called "Makefile.in") appropriate to your system. Make sure you run +configure with the same arguments as when you ran Tcl's configure +script. (If you don't, package loading won't work.) + +Most people will not need to make any changes to the generated +Makefile and can go on to the next step. If you want though, you can +edit the Makefile and change any definitions as appropriate for your +site. All the definitions you are likely to want to change are +clearly identified and described at the beginning of the file. + +Run "make". + +It is useful (although not necessary) for cgi.tcl to understand how to +send mail. By default, cgi.tcl tries to use /usr/lib/sendmail, +otherwise it falls back to carrying out the raw SMTP dialogue itself. +Any mailer can be substituted by modifying cgi.tcl appropriately. It +is easy to do. Edit cgi.tcl and look at the cgi_mail_end procedure. +It should be obvious what to do at that point. The ability to send +mail isn't required for basic use of cgi.tcl, but it is especially +useful for in-the-field debugging so I encourage you to enable it. + +You can now "source cgi.tcl" if you want to try things out by hand +before installing (or if you want to use the package without +installing it). Example: + + $ tclsh7.6 (or whatever your Tcl interpreter is called) + % source cgi.tcl + % h4 "Don Libes" + <h4>Don Libes</h4> + % + +Once you're done playing, go ahead and install it. To install everything: + + make install + +You're done! Now you can use cgi.tcl. + +-------------------- +Examples +-------------------- + +The example directory has some examples. See the README in there. + +-------------------- +Test Suite +-------------------- + +There is no test suite. + +-------------------- +Uninstalling +-------------------- + +"make uninstall" removes all the files that "make install" creates +(excluding those in the current directory). + +-------------------- +Cleaning Up +-------------------- + +Several "clean" targets are available to reduce space consumption of +the cgi.tcl source. The two most useful are as follows: + +"make clean" deletes all files from the current directory that were +created by "make" + +"make distclean" is like "make clean", but it also deletes files +created by "configure" + +Other targets can be found in the Makefile. They follow the GNU +Makefile conventions. + diff --git a/web/src/cgi.tcl-1.10/Makefile.in b/web/src/cgi.tcl-1.10/Makefile.in new file mode 100644 index 00000000..3f818f2c --- /dev/null +++ b/web/src/cgi.tcl-1.10/Makefile.in @@ -0,0 +1,273 @@ +# +# Makefile for Don Libes' cgi.tcl - routines for writing CGI scripts in Tcl +# + +VERSION = \"@CGI_VERSION_FULL@\" +SHORT_VERSION = @CGI_VERSION@ + +srcdir = @srcdir@ +VPATH = @srcdir@ +SUBDIRS = @subdirs@ + +###################################################################### +# The following lines are things you may want to change +###################################################################### + +# By default, "make install" will install the appropriate files in +# /usr/local/bin, /usr/local/lib, /usr/local/man, etc. By changing this +# variable, you can specify an installation prefix other than /usr/local. +# You may find it preferable to call configure with the --prefix option +# to control this information. This is especially handy if you are +# installing this several times (perhaps on a number of machines or +# in different places). Then you don't have to hand-edit this file. +# See the INSTALL file for more information. (Analogous information +# applies to the next variable as well.) +prefix = @prefix@ + +# You can specify a separate installation prefix for architecture-specific +# files such as binaries and libraries. +exec_prefix = @exec_prefix@ + +# Short directory path where binaries can be found to support #! hack. +# This directory path can be the same as the directory in which the binary +# actually sits except when the path is so long that the #! mechanism breaks +# (usually at 32 characters). +# The solution is to create a directory with a very short name, which consists +# only of symbolic links back to the true binaries. Subtracting two for "#!" +# and a couple more for arguments (typically " -f" or " --") gives you 27 +# characters. Pathnames over this length won't be able to use the #! magic. +# For more info on this, see the execve(2) man page. +SHORT_BINDIR = $(exec_prefix)/bin + +# Tcl interpreter for utility work. +CGI_TCL_EXECUTABLE = @CGI_TCL_EXECUTABLE@ + +# Where to put the examples - a directory in which your web server has +# permission to execute CGI scripts. +exampledir = /tmp/cgi-bin/cgi-tcl-examples + +###################################################################### +# End of things you may want to change +# +# Do not change anything after this +###################################################################### + +bindir_arch_indep = $(prefix)/bin +libdir = $(exec_prefix)/lib +datadir = $(prefix)/lib + +mandir = $(prefix)/man +man1dir = $(mandir)/man1 +man3dir = $(mandir)/man3 +docdir = $(datadir)/doc + +# utility script directories - arch-independent and arch-non- +# independent. +SCRIPTDIR = $(datadir)/cgi$(SHORT_VERSION) +EXECSCRIPTDIR = $(execdatadir)/cgi$(SHORT_VERSION) + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_DATA = @INSTALL_DATA@ + +# To install the following examples: make examples +EXAMPLES=cookie.cgi creditcard.cgi \ + display.cgi display-in-frame.cgi download.cgi \ + echo.cgi error.cgi evaljs.cgi example.tcl examples.cgi \ + form-tour.cgi form-tour-result.cgi format-tour.cgi frame.cgi \ + image.cgi img.cgi kill.cgi nistguest.cgi oratcl.cgi \ + parray.cgi passwd.tcl passwd-form.cgi passwd.cgi \ + push.cgi rm.cgi stopwatch.cgi \ + unimail.cgi upload.cgi uploadbin.cgi \ + validate.cgi vclock.cgi vclock.pl vclock-src-frame.cgi visitor.cgi \ + vote.cgi + +EXAMPLES_DATA=nistguest vote.cnt + +all: cgi.tcl pkgIndex.tcl + +info: +dvi: + +# Delete all the installed files that the `install' target creates +# (but not the noninstalled files such as `make all' creates) +uninstall: + -rm -f $(SCRIPTDIR)/cgi.tcl + -rm -f $(man3dir)/cgi.tcl.3 + -rm -f $(SCRIPTDIR)/pkgIndex.tcl + +.PHONY: install-info install info +install-info: + +install: all + ${srcdir}/mkinstalldirs $(man3dir) $(SCRIPTDIR) $(exampledir) $(exampledir)/data +# install scripts + $(INSTALL_DATA) cgi.tcl $(SCRIPTDIR) +# install library man page + $(INSTALL_DATA) cgi.tcl.man $(man3dir)/cgi.tcl.3 + $(INSTALL_DATA) pkgIndex.tcl $(SCRIPTDIR) + +examples: + for i in $(EXAMPLES) ; do \ + $(CGI_TCL_EXECUTABLE) $(srcdir)/fixline1 $(SHORT_BINDIR) < $(srcdir)/example/$$i > $$i ; \ + $(INSTALL_PROGRAM) $$i $(exampledir) ; \ + rm -f $$i ; \ + done + for i in $(EXAMPLES_DATA) ; do \ + $(INSTALL) -m 666 $(srcdir)/example/$$i $(exampledir)/data ; \ + done + +cgi.tcl: $(srcdir)/cgi.tcl.in + @echo "Rebuilding cgi.tcl..." + $(SHELL) ./config.status + +################################### +# Targets for Makefile and configure +################################### + +Makefile: $(srcdir)/Makefile.in $(host_makefile_frag) config.status + @echo "Rebuilding the Makefile..." + $(SHELL) ./config.status + +# Let "make -f Makefile.in" produce a configure file +configure: $(srcdir)/configure.in $(srcdir)/Makefile.in + @echo "Rebuilding configure..." + if [ x"${srcdir}" = x"@srcdir@" ] ; then \ + srcdir=. ; export srcdir ; \ + else true ; fi ; \ + (cd $${srcdir}; autoconf) + +config.status: $(srcdir)/configure + @echo "Rebuilding config.status..." + $(SHELL) ./config.status --recheck + +check: + @if [ -f testsuite/Makefile ]; then \ + cd testsuite && $(MAKE) $(FLAGS_TO_PASS) check; \ + else true; fi + +# updating of pkgIndex.tcl has not yet been totally automated +# Instructions: +# 1) Replace version # in cgi.tcl with updated version. +# (Gad, I'd have to turn the whole source into .in file to automate this +# and it'd be a major nuisance when developing!) +pkgIndex.tcl: cgi.tcl + $(CGI_TCL_EXECUTABLE) pkgcreate + +################################################ +# Various "clean" targets follow GNU conventions +################################################ + +# delete all files from current directory that are created by "make" +clean: + -rm -f *~ *.o core + +# like "clean", but also delete files created by "configure" +distclean: clean + -rm -f Makefile config.status config.cache config.log + -rm -f Dbg_cf.h + +# like "clean", but doesn't delete test utilities or massaged scripts +# because most people don't have to worry about them +mostlyclean: + -rm -f *~ *.o core + +# delete everything from current directory that can be reconstructed +# except for configure +realclean: distclean + +###################################### +# Targets for pushing out releases +###################################### + +FTPDIR = /itl/www/div826/subject/expect/cgi.tcl + +# make a private tar file for myself +tar: cgi.tcl-$(SHORT_VERSION).tar + mv cgi.tcl-$(SHORT_VERSION).tar cgi.tcl.tar + +# Make a release and install it on ftp server +# Note that we run configure on our end to make sure that cgi.tcl is usable +# for people who don't have configure at the destination end (non-UNIX folks). +ftp: cgi.tcl cgi.tcl-$(SHORT_VERSION).tar.Z cgi.tcl-$(SHORT_VERSION).tar.gz install-html + cp cgi.tcl-$(SHORT_VERSION).tar.Z $(FTPDIR)/cgi.tcl.tar.Z + cp cgi.tcl-$(SHORT_VERSION).tar.gz $(FTPDIR)/cgi.tcl.tar.gz + cp HISTORY $(FTPDIR) + cp README $(FTPDIR)/README.distribution + cp doc/ref.txt $(FTPDIR) + cp doc/ref.html $(FTPDIR) + cp example/README $(FTPDIR)/example + cp `pubfile example` $(FTPDIR)/example + ls -l $(FTPDIR)/cgi.tcl.tar* +# delete temp files + rm cgi.tcl-$(SHORT_VERSION).tar* + +cgi.tcl-$(SHORT_VERSION).tar: configure + rm -f ../cgi.tcl-$(SHORT_VERSION) + ln -s `pwd` ../cgi.tcl-$(SHORT_VERSION) + cd ..;tar cvfh $@ `pubfile cgi.tcl-$(SHORT_VERSION)` + mv ../$@ . + +cgi.tcl-$(SHORT_VERSION).tar.Z: cgi.tcl-$(SHORT_VERSION).tar + compress -fc cgi.tcl-$(SHORT_VERSION).tar > $@ + +cgi.tcl-$(SHORT_VERSION).tar.gz: cgi.tcl-$(SHORT_VERSION).tar + gzip -fc cgi.tcl-$(SHORT_VERSION).tar > $@ + +########################### +# Targets for producing FAQ and homepage +########################### + +NISTCGI_PREFIX = /local +NISTCGI_HOST = ats.nist.gov +NISTCGI_INTERPDIR = $(NISTCGI_PREFIX)/bin +NISTCGI_LIBDIR = $(NISTCGI_PREFIX)/lib/cgi$(SHORT_VERSION) +NISTCGI_EXAMPLEDIR = $(NISTCGI_HOST):/private/home/http/cgi-bin/cgi.tcl +NISTCGI_HTMLDIR = /itl/www/div826/subject/expect/cgi.tcl + +# create the FAQ in html form +FAQ.html: FAQ.src FAQ.tcl + FAQ.src > FAQ.html + +# create the FAQ in text form +#FAQ: FAQ.src FAQ.tcl +# FAQ.src text > FAQ + +# generate home page +homepage.html: homepage.src common.tcl configure + homepage.src > homepage.html + +realapps.html: realapps.src common.tcl + realapps.src > realapps.html + +RSH = ssh +RCP = scp + +# install various html docs on our web server +install-html: FAQ.html homepage.html realapps.html pkgIndex.tcl cgi.tcl + cp FAQ.html $(NISTCGI_HTMLDIR)/ + cp homepage.html $(NISTCGI_HTMLDIR)/index.html + cp realapps.html $(NISTCGI_HTMLDIR)/ + -$(RSH) $(NISTCGI_HOST) mkdir $(NISTCGI_LIBDIR)/ + $(RCP) cgi.tcl pkgIndex.tcl $(NISTCGI_HOST):$(NISTCGI_LIBDIR)/ + for i in $(EXAMPLES) ; do \ + $(CGI_TCL_EXECUTABLE) $(srcdir)/fixline1 $(NISTCGI_INTERPDIR) < $(srcdir)/example/$$i > $$i ; \ + $(RCP) $$i $(NISTCGI_EXAMPLEDIR)/ ; \ + rm -f $$i ; \ + done + +# add recursive support to the build process. +subdir_do: force + @for i in $(SUBDIRS); do \ + echo "Making $(DO) in $${i}..." ; \ + if [ -d ./$$i ] ; then \ + if (rootme=`pwd`/ ; export rootme ; \ + rootsrc=`cd $(srcdir); pwd`/ ; export rootsrc ; \ + cd ./$$i; \ + $(MAKE) $(FLAGS_TO_PASS) $(DO)) ; then true ; \ + else exit 1 ; fi ; \ + else true ; fi ; \ + done +force: + +## dependencies will be put after this line... ## diff --git a/web/src/cgi.tcl-1.10/PATCH.UW b/web/src/cgi.tcl-1.10/PATCH.UW new file mode 100644 index 00000000..0288cb72 --- /dev/null +++ b/web/src/cgi.tcl-1.10/PATCH.UW @@ -0,0 +1,230 @@ +*** ./cgi.tcl.in.orig 2006-05-01 11:15:52.000000000 -0700 +--- ./cgi.tcl.in 2006-11-14 16:01:51.000000000 -0800 +*************** +*** 52,58 **** + + if {[info exists _cgi(http_status_done)]} return + set _cgi(http_status_done) 1 +! puts "Status: $num $str" + } + + # If these are called manually, they automatically generate the extra newline +--- 52,58 ---- + + if {[info exists _cgi(http_status_done)]} return + set _cgi(http_status_done) 1 +! cgi_puts "Status: $num $str" + } + + # If these are called manually, they automatically generate the extra newline +*************** +*** 1342,1348 **** + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + # explicitly flush all writes to fout, because sometimes the writer + # can hang and we won't get to the termination code +! set dbg_fout [open $dbg_filename w] + set _cgi(input) $dbg_filename + catch {fconfigure $dbg_fout -translation binary} + } +--- 1342,1348 ---- + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + # explicitly flush all writes to fout, because sometimes the writer + # can hang and we won't get to the termination code +! set dbg_fout [open $dbg_filename w $_cgi(tmpperms)] + set _cgi(input) $dbg_filename + catch {fconfigure $dbg_fout -translation binary} + } +*************** +*** 1409,1415 **** + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! set fout [open $foutname w] + # "catch" permits this to work with Tcl 7.4 + catch {fconfigure $fout -translation binary} + _cgi_set_uservar $varname [list $foutname $filename $conttype] +--- 1409,1415 ---- + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! set fout [open $foutname w $_cgi(tmpperms)] + # "catch" permits this to work with Tcl 7.4 + catch {fconfigure $fout -translation binary} + _cgi_set_uservar $varname [list $foutname $filename $conttype] +*************** +*** 1452,1457 **** +--- 1452,1458 ---- + } else { + # read the part into a variable + set val "" ++ set blanks 0 + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} +*************** +*** 1463,1468 **** +--- 1464,1479 ---- + append val \n + } + regexp (.*)\r$ $buf dummy buf ++ if {[info exists blanks]} { ++ if {0!=[string compare $buf ""]} { ++ if {$blanks} { ++ append val [string repeat \n [incr blanks]] ++ } ++ unset blanks ++ } else { ++ incr blanks ++ } ++ } + append val $buf + } + _cgi_set_uservar $varname $val +*************** +*** 1482,1488 **** + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + set _cgi(input) $dbg_filename +! spawn -open [open $dbg_filename w] + set dbg_sid $spawn_id + } + spawn -open $fin +--- 1493,1499 ---- + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + set _cgi(input) $dbg_filename +! spawn -open [open $dbg_filename w $_cgi(tmpperms)] + set dbg_sid $spawn_id + } + spawn -open $fin +*************** +*** 1579,1585 **** + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! spawn -open [open $foutname w] + set fout_sid $spawn_id + + _cgi_set_uservar $varname [list $foutname $filename $conttype] +--- 1590,1596 ---- + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] +! spawn -open [open $foutname w $_cgi(tmpperms)] + set fout_sid $spawn_id + + _cgi_set_uservar $varname [list $foutname $filename $conttype] +*************** +*** 2187,2202 **** + + flush $_cgi(mailfid) + +! if {[file executable /usr/lib/sendmail]} { +! exec /usr/lib/sendmail -t -odb < $_cgi(mailfile) +! # Explanation: +! # -t means: pick up recipient from body +! # -odb means: deliver in background +! # note: bogus local address cause sendmail to fail immediately +! } elseif {[file executable /usr/sbin/sendmail]} { +! exec /usr/sbin/sendmail -t -odb < $_cgi(mailfile) +! # sendmail is in /usr/sbin on some BSD4.4-derived systems. +! } else { + # fallback for sites without sendmail + + if {0==[info exists _cgi(mail_relay)]} { +--- 2198,2215 ---- + + flush $_cgi(mailfid) + +! foreach sendmail in $_cgi(sendmail) { +! if {[file executable $sendmail]} { +! exec $sendmail -t -odb < $_cgi(mailfile) +! # Explanation: +! # -t means: pick up recipient from body +! # -odb means: deliver in background +! # note: bogus local address cause sendmail to fail immediately +! set sent 1 +! } +! } +! +! if {0==[info exists sent]} { + # fallback for sites without sendmail + + if {0==[info exists _cgi(mail_relay)]} { +*************** +*** 2241,2246 **** +--- 2254,2265 ---- + set _cgi(mail_relay) $host + } + ++ proc cgi_sendmail {path} { ++ global _cgi ++ ++ set _cgi(sendmail) $path ++ } ++ + ################################################## + # cookie support + ################################################## +*************** +*** 2416,2422 **** + ################################################## + + proc cgi_stylesheet {href} { +! puts "<link rel=stylesheet href=\"$href\" type=\"text/css\"/>" + } + + proc cgi_span {args} { +--- 2435,2441 ---- + ################################################## + + proc cgi_stylesheet {href} { +! cgi_puts "<link rel=stylesheet href=\"$href\" type=\"text/css\"/>" + } + + proc cgi_span {args} { +*************** +*** 2545,2550 **** +--- 2564,2584 ---- + } + + ################################################## ++ # temporary file procedures ++ ################################################## ++ ++ # set appropriate temporary file modes ++ proc cgi_tmpfile_permissions {{mode ""}} { ++ global _cgi ++ ++ if {[string length $mode]} { ++ set _cgi(tmpperms) $mode ++ } ++ ++ return $_cgi(tmpperms) ++ } ++ ++ ################################################## + # user-defined procedures + ################################################## + +*************** +*** 2604,2615 **** +--- 2638,2655 ---- + switch $tcl_platform(platform) { + unix { + set _cgi(tmpdir) /tmp ++ set _cgi(tmpperms) 0644 ++ set _cgi(sendmail) [list /usr/lib/sendmail /usr/sbin/sendmail] + } macintosh { + set _cgi(tmpdir) [pwd] ++ set _cgi(tmpperms) {} ++ set _cgi(sendmail) {} + } default { + set _cgi(tmpdir) [pwd] + catch {set _cgi(tmpdir) $env(TMP)} + catch {set _cgi(tmpdir) $env(TEMP)} ++ set _cgi(tmpperms) {} ++ set _cgi(sendmail) {} + } + } + diff --git a/web/src/cgi.tcl-1.10/README b/web/src/cgi.tcl-1.10/README new file mode 100644 index 00000000..4c7381fe --- /dev/null +++ b/web/src/cgi.tcl-1.10/README @@ -0,0 +1,140 @@ +This is the README to cgi.tcl, a library of Tcl procedures to assist +in writing CGI scripts. Review the HISTORY file for significant changes. + +The cgi.tcl home page is http://expect.nist.gov/cgi.tcl + +-------------------- +Introduction +-------------------- + +This is the README file for cgi.tcl, a set of procedures for writing +CGI scripts in Tcl. The procedures implement the code described in +the paper "Writing CGI scripts in Tcl" which was published in the +Proceedings of the Fourth Tcl Workshop (Tcl '96). + +-------------------- +Getting Started +-------------------- + +First, read the paper "Writing CGI Scripts in Tcl", from Tcl '96. If +you can't find the paper in this archive, it can also be found at: + + http://www.nist.gov/msidlibrary/doc/libes96c.ps + +That paper will give you a lot of good ideas for using Tcl, not only +with CGI but plain everyday HTML as well. + +Next, try some of the examples in the example directory. Please read +the "Instructions" section in example/README first. + +A rough draft of complete documentation of the individual functions +can be found in ref.txt in the doc directory. + +Note that you are expected to understand Tcl. I'm not going to +explain how to write Tcl scripts here. (If you're looking for a Tcl +tutorial, please consider my Expect book which includes a very nice +tutorial on Tcl.) + +Similarly, you are expected to understand HTML. There are plenty of +web tutorials and books on it. Go read one. You don't have to become +an expert on HTML, but it is important to get a feel for it. (The +cgi.tcl package will take care of the details.) If you plan to do +CGI, you should know a couple more basic things. Here's a simple CGI +intro: + + http://hoohoo.ncsa.uiuc.edu/cgi/intro.html + + +-------------------- +Status +-------------------- + +The library is reasonably complete. It supports forms, tables, +cookies, Netscape extensions, file upload, plug-ins, etc, etc. On the +other hand, there are some things missing - such as certain deprecated +things in HTML, things I can't believe anyone would use, things that +are special extensions to a browser I'm not familiar with, etc. + +This library should run on any system (UNIX, Win, or Mac) which +supports Tcl 8.1 or later. + +---------------------- +Examples +---------------------- + +This distribution contains example scripts. They can be found in the +example directory of this distribution. Please read the +"Instructions" section in example/README first. + +-------------------- +Installation +-------------------- + +If you are on UNIX, read the INSTALL file. +If you are on W95/NT, read the install.win file. +If you are on Mac, read the install.mac file. + +-------------------- +How to get the latest version of this code +-------------------- + +The latest version of this code may be received from: + + http://expect.nist.gov/cgi.tcl/cgi.tcl.tar.gz +or ftp://ftp.nist.gov/mel/div826/subject/expect/cgi.tcl/cgi.tcl.tar.gz + +-------------------- +Support from Don Libes or NIST +-------------------- + +Although I can't promise anything in the way of support, I'd be +interested to hear about your experiences using it (good or bad). I'm +also interested in hearing bug reports and suggestions for improvement +even though I can't promise to implement them. + +If you send me a bug, fix, or question, include the version of +cgi.tcl, version of Tcl, and name and version of the OS that you are +using. Before sending mail, it may be helpful to verify that your +problem still exists in the latest version. You can check on the +current release and whether it addresses your problems by retrieving +the latest HISTORY file (see "History" above). + + +Awards, love letters, and bug reports may be sent to: + +Don Libes +National Institute of Standards and Technology +Bldg 220, Rm A-127 +Gaithersburg, MD 20899 +(301) 975-3535 +libes@nist.gov + +I hereby place this software in the public domain. NIST and I would +appreciate credit if this program or parts of it are used. + +Design and implementation of this program was funded primarily by +myself. Funding contributors include the NIST Automated Manufacturing +Research Facility (funded by the Navy Manufacturing Technology +Program), the NIST Scientific and Technical Research Services, the +ARPA Persistent Object Bases project and the Computer-aided +Acquisition and the Logistic Support (CALS) program of the Office of +the Secretary of Defense. + +-------------------- +Support for Don Libes or NIST +-------------------- + +NIST accepts external funding and other resources (hardware, software, +and personnel). This can be a fine way to work more closely with NIST +and encourage particular areas of research. + +Funding can be earmarked for specific purposes or for less-specific +purposes. For example, if you simply like the work I do, you can +contribute directly to my funding which will reduce the amount of time +I have to spend writing proposals and submitting them to other people +for funding on my own. + +I can also participate in the NIST Fellows program allowing me to +spend several months to a year working directly with your company and +potentially even at your location. + diff --git a/web/src/cgi.tcl-1.10/README.UW b/web/src/cgi.tcl-1.10/README.UW new file mode 100644 index 00000000..7dfe161c --- /dev/null +++ b/web/src/cgi.tcl-1.10/README.UW @@ -0,0 +1,23 @@ +This is the README.UW of the cgi.tcl library as included with the Web +Alpine distribution. + +Web Alpine page generation is based heavily on the routines provided +by the cgi.tcl library. It's shown to be a robust and flexible +platform for generating dynamic web-based content. + +This cgi.tcl library as included with the Web Alpine application has +been slightly modified. The small changes, which can be found in +PATCH.UW, amount to a few things: + + 1) A hook to allow for temporary file permission setting + + 2) A hook to allow for resetting (and specifically, unsetting) + the path to sendmail used for error reporting + + 3) A few fixes for misdirected output ("puts" --> "cgi_puts") + + 4) Change to _cgi_input_multipart to preserve leading + newlines + +For comments or questions regarding the Web Alpine application +send comments to <alpine-contact@cac.washington.edu> diff --git a/web/src/cgi.tcl-1.10/cgi.tcl.in b/web/src/cgi.tcl-1.10/cgi.tcl.in new file mode 100644 index 00000000..df426c08 --- /dev/null +++ b/web/src/cgi.tcl-1.10/cgi.tcl.in @@ -0,0 +1,2659 @@ +################################################## +# +# cgi.tcl - routines for writing CGI scripts in Tcl +# Author: Don Libes <libes@nist.gov>, January '95 +# +# These routines implement the code described in the paper +# "Writing CGI scripts in Tcl" which appeared in the Tcl '96 conference. +# Please read the paper before using this code. The paper is: +# http://expect.nist.gov/doc/cgi.pdf +# +################################################## + +################################################## +# http header support +################################################## + +proc cgi_http_head {args} { + global _cgi env errorInfo + + if {[info exists _cgi(http_head_done)]} return + + set _cgi(http_head_in_progress) 1 + + if {0 == [llength $args]} { + cgi_content_type + } else { + if {[catch {uplevel 1 [lindex $args 0]} errMsg]} { + set savedInfo $errorInfo + cgi_content_type + } + } + cgi_puts "" + + unset _cgi(http_head_in_progress) + set _cgi(http_head_done) 1 + + if {[info exists savedInfo]} { + error $errMsg $savedInfo + } +} + +# avoid generating http head if not in CGI environment +# to allow generation of pure HTML files +proc _cgi_http_head_implicit {} { + global env + + if {[info exists env(REQUEST_METHOD)]} cgi_http_head +} + +proc cgi_status {num str} { + global _cgi + + if {[info exists _cgi(http_status_done)]} return + set _cgi(http_status_done) 1 + cgi_puts "Status: $num $str" +} + +# If these are called manually, they automatically generate the extra newline + +proc cgi_content_type {args} { + global _cgi + + if {0==[llength $args]} { + set t text/html + } else { + set t [lindex $args 0] + if {[regexp ^multipart/ $t]} { + set _cgi(multipart) 1 + } + } + + if {[info exists _cgi(http_head_in_progress)]} { + cgi_puts "Content-type: $t" + } else { + cgi_http_head [list cgi_content_type $t] + } +} + +proc cgi_redirect {t} { + global _cgi + + if {[info exists _cgi(http_head_in_progress)]} { + cgi_status 302 Redirected + cgi_puts "Uri: $t" + cgi_puts "Location: $t" + } else { + cgi_http_head { + cgi_redirect $t + } + } +} + +# deprecated, use cgi_redirect +proc cgi_location {t} { + global _cgi + + if {[info exists _cgi(http_head_in_progress)]} { + cgi_puts "Location: $t" + } else { + cgi_http_head "cgi_location $t" + } +} + +proc cgi_target {t} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "cgi_target must be set from within cgi_http_head." + } + cgi_puts "Window-target: $t" +} + +# Make client retrieve url in this many seconds ("client pull"). +# With no 2nd arg, current url is retrieved. +proc cgi_refresh {seconds {url ""}} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "cgi_refresh must be set from within cgi_http_head. Try using cgi_http_equiv instead." + } + cgi_put "Refresh: $seconds" + + if {0!=[string compare $url ""]} { + cgi_put "; $url" + } + cgi_puts "" +} + +# Example: cgi_pragma no-cache +proc cgi_pragma {arg} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "cgi_pragma must be set from within cgi_http_head." + } + cgi_puts "Pragma: $arg" +} + +################################################## +# support for debugging or other crucial things we need immediately +################################################## + +proc cgi_comment {args} {} ;# need this asap + +proc cgi_html_comment {args} { + regsub -all {>} $args {\>} args + cgi_put "<!--[_cgi_list_to_string $args] -->" +} + +set _cgi(debug) -off +proc cgi_debug {args} { + global _cgi + + set old $_cgi(debug) + set arg [lindex $args 0] + if {$arg == "-on"} { + set _cgi(debug) -on + set args [lrange $args 1 end] + } elseif {$arg == "-off"} { + set _cgi(debug) -off + set args [lrange $args 1 end] + } elseif {[regexp "^-t" $arg]} { + set temp 1 + set _cgi(debug) -on + set args [lrange $args 1 end] + } elseif {[regexp "^-noprint$" $arg]} { + set noprint 1 + set args [lrange $args 1 end] + } + + set arg [lindex $args 0] + if {$arg == "--"} { + set args [lrange $args 1 end] + } + + if {[llength $args]} { + if {$_cgi(debug) == "-on"} { + + _cgi_close_tag + # force http head and open html, head, body + catch { + if {[info exists noprint]} { + uplevel 1 [lindex $args 0] + } else { + cgi_html { + cgi_head { + cgi_title "debugging before complete HTML head" + } + # force body open and leave open + _cgi_body_start + uplevel 1 [lindex $args 0] + # bop back out to catch, so we don't close body + error "ignore" + } + } + } + } + } + + if {[info exists temp]} { + set _cgi(debug) $old + } + return $old +} + +proc cgi_uid_check {user} { + global env + + # leave in so old scripts don't blow up + if {[regexp "^-off$" $user]} return + + if {[info exists env(USER)]} { + set whoami $env(USER) + } elseif {0==[catch {exec whoami} whoami]} { + # "who am i" on some Linux hosts returns "" so try whoami first + } elseif {0==[catch {exec who am i} whoami]} { + # skip over "host!" + regexp "(.*!)?(\[^ \t]*)" $whoami dummy dummy whoami + } elseif {0==[catch {package require registry}]} { + set whoami [registry get HKEY_LOCAL_MACHINE\\Network\\Logon username] + } else { + set whoami $user ;# give up and let go + } + if {$whoami != "$user"} { + error "Warning: This CGI script expects to run with uid \"$user\". However, this script is running as \"$whoami\"." + } +} + +# print out elements of an array +# like Tcl's parray, but formatted for browser +proc cgi_parray {a {pattern *}} { + upvar 1 $a array + if {![array exists array]} { + error "\"$a\" isn't an array" + } + + set maxl 0 + foreach name [lsort [array names array $pattern]] { + if {[string length $name] > $maxl} { + set maxl [string length $name] + } + } + cgi_preformatted { + set maxl [expr {$maxl + [string length $a] + 2}] + foreach name [lsort [array names array $pattern]] { + set nameString [format %s(%s) $a $name] + cgi_puts [cgi_quote_html [format "%-*s = %s" $maxl $nameString $array($name)]] + } + } +} + +proc cgi_eval {cmd} { + global env _cgi + + # put cmd somewhere that uplevel can find it + set _cgi(body) $cmd + + uplevel 1 { + global env _cgi errorInfo + + if {1==[catch $_cgi(body) errMsg]} { + # error occurred, handle it + set _cgi(errorInfo) $errorInfo + + if {![info exists env(REQUEST_METHOD)]} { + puts stderr $_cgi(errorInfo) + return + } + # the following code is all to force browsers into a state + # such that diagnostics can be reliably shown + + # close irrelevant things + _cgi_close_procs + # force http head and open html, head, body + cgi_html { + cgi_body { + if {[info exists _cgi(client_error)]} { + cgi_h3 "Client Error" + cgi_p "$errMsg Report this to your system administrator or browser vendor." + } else { + cgi_put [cgi_anchor_name cgierror] + cgi_h3 "An internal error was detected in the service\ + software. The diagnostics are being emailed to\ + the service system administrator ($_cgi(admin_email))." + + if {$_cgi(debug) == "-on"} { + cgi_puts "Heck, since you're debugging, I'll show you the\ + errors right here:" + # suppress formatting + cgi_preformatted { + cgi_puts [cgi_quote_html $_cgi(errorInfo)] + } + } else { + cgi_mail_start $_cgi(admin_email) + cgi_mail_add "Subject: [cgi_name] CGI problem" + cgi_mail_add + cgi_mail_add "CGI environment:" + cgi_mail_add "REQUEST_METHOD: $env(REQUEST_METHOD)" + cgi_mail_add "SCRIPT_NAME: $env(SCRIPT_NAME)" + # this next few things probably don't need + # a catch but I'm not positive + catch {cgi_mail_add "HTTP_USER_AGENT: $env(HTTP_USER_AGENT)"} + catch {cgi_mail_add "HTTP_REFERER: $env(HTTP_REFERER)"} + catch {cgi_mail_add "HTTP_HOST: $env(HTTP_HOST)"} + catch {cgi_mail_add "REMOTE_HOST: $env(REMOTE_HOST)"} + catch {cgi_mail_add "REMOTE_ADDR: $env(REMOTE_ADDR)"} + cgi_mail_add "cgi.tcl version: @CGI_VERSION_FULL@" + cgi_mail_add "input:" + catch {cgi_mail_add $_cgi(input)} + cgi_mail_add "cookie:" + catch {cgi_mail_add $env(HTTP_COOKIE)} + cgi_mail_add "errorInfo:" + cgi_mail_add "$_cgi(errorInfo)" + cgi_mail_end + } + } + } ;# end cgi_body + } ;# end cgi_html + } ;# end catch + } ;# end uplevel +} + +# return true if cgi_eval caught an error +proc cgi_error_occurred {} { + global _cgi + + return [info exists _cgi(errorInfo)] +} + +################################################## +# CGI URL creation +################################################## + +# declare location of root of CGI files +# this allows all CGI references to be relative in the source +# making it easy to move everything in the future +# If you have multiple roots, just don't call this. +proc cgi_root {args} { + global _cgi + + if {[llength $args]} { + set _cgi(root) [lindex $args 0] + } else { + set _cgi(root) + } +} + +# make a URL for a CGI script +proc cgi_cgi {args} { + global _cgi + + set root $_cgi(root) + if {0!=[string compare $root ""]} { + if {![regexp "/$" $root]} { + append root "/" + } + } + + set suffix [cgi_suffix] + + set arg [lindex $args 0] + if {0==[string compare $arg "-suffix"]} { + set suffix [lindex $args 1] + set args [lrange $args 2 end] + } + + if {[llength $args]==1} { + return $root[lindex $args 0]$suffix + } else { + return $root[lindex $args 0]$suffix?[join [lrange $args 1 end] &] + } +} + +proc cgi_suffix {args} { + global _cgi + if {[llength $args] > 0} { + set _cgi(suffix) [lindex $args 0] + } + if {![info exists _cgi(suffix)]} { + return .cgi + } else { + return $_cgi(suffix) + } +} + +proc cgi_cgi_set {variable value} { + regsub -all {%} $value "%25" value + regsub -all {&} $value "%26" value + regsub -all {\+} $value "%2b" value + regsub -all { } $value "+" value + regsub -all {=} $value "%3d" value + regsub -all {#} $value "%23" value + regsub -all {/} $value "%2f" value ;# Added... + return $variable=$value +} + +################################################## +# URL dictionary support +################################################## + +proc cgi_link {args} { + global _cgi_link + + set tag [lindex $args 0] + switch -- [llength $args] { + 1 { + set label $_cgi_link($tag,label) + } 2 { + set label [lindex $args end] + } default { + set _cgi_link($tag,label) [set label [lindex $args 1]] + set _cgi_link($tag,url) [lrange $args 2 end] + } + } + + return [eval cgi_url [list $label] $_cgi_link($tag,url)] +} + +# same as above but for images +# note: uses different namespace +proc cgi_imglink {args} { + global _cgi_imglink + + set tag [lindex $args 0] + if {[llength $args] >= 2} { + set _cgi_imglink($tag) [eval cgi_img [lrange $args 1 end]] + } + return $_cgi_imglink($tag) +} + +proc cgi_link_label {tag} { + global _cgi_link + return $_cgi_link($tag,label) +} + +proc cgi_link_url {tag} { + global _cgi_link + return $_cgi_link($tag,url) +} + +################################################## +# hyperlink support +################################################## + +# construct a hyperlink labeled "display" +# last arg is the link destination +# any other args are passed through into <a> display +proc cgi_url {display args} { + global _cgi + + set buf "<a href=\"[lindex $args 0]\"" + foreach a [lrange $args 1 end] { + if {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf>$display</a>" +} + +# generate an image reference (<img ...>) +# first arg is image url +# other args are passed through into <img> tag +proc cgi_img {args} { + global _cgi + + set buf "<img src=\"[lindex $args 0]\"" + foreach a [lrange $args 1 end] { + if {[regexp "^(alt|lowsrc|usemap)=(.*)" $a dummy attr str]} { + append buf " $attr=[cgi_dquote_html $str]" + } elseif {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf />" +} + +# names an anchor so that it can be linked to +proc cgi_anchor_name {name} { + return "<a name=\"$name\"/>" +} + +proc cgi_base {args} { + global _cgi + + cgi_put "<base" + foreach a $args { + if {[regexp "^href=(.*)" $a dummy str]} { + cgi_put " href=[cgi_dquote_html $str]" + } elseif {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts " />" +} + +################################################## +# quoting support +################################################## + +if {[info tclversion] >= 8.2} { + proc cgi_unquote_input buf { + # rewrite "+" back to space + # protect \ from quoting another \ and throwing off other things + # replace line delimiters with newlines + set buf [string map -nocase [list + { } "\\" "\\\\" %0d%0a \n] $buf] + + # prepare to process all %-escapes + regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {\\u00\1} buf + + # process \u unicode mapped chars + encoding convertfrom $::_cgi(queryencoding) \ + [subst -novar -nocommand $buf] + } +} elseif {[info tclversion] >= 8.1} { + proc cgi_unquote_input buf { + # rewrite "+" back to space + regsub -all {\+} $buf { } buf + # protect \ from quoting another \ and throwing off other things + regsub -all {\\} $buf {\\\\} buf + + # replace line delimiters with newlines + regsub -all -nocase "%0d%0a" $buf "\n" buf + + # prepare to process all %-escapes + regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {\\u00\1} buf + # process \u unicode mapped chars + return [subst -novar -nocommand $buf] + } +} else { + proc cgi_unquote_input {buf} { + # rewrite "+" back to space + regsub -all {\+} $buf { } buf + # protect \ from quoting another \ and throwing off other things first + # protect $ from doing variable expansion + # protect [ from doing evaluation + # protect " from terminating string + regsub -all {([\\["$])} $buf {\\\1} buf + + # replace line delimiters with newlines + regsub -all -nocase "%0d%0a" $buf "\n" buf + # Mosaic sends just %0A. This is handled in the next command. + + # prepare to process all %-escapes + regsub -all -nocase {%([a-f0-9][a-f0-9])} $buf {[format %c 0x\1]} buf + # process %-escapes and undo all protection + eval return \"$buf\" + } +} + +# return string but with html-special characters escaped, +# necessary if you want to send unknown text to an html-formatted page. +proc cgi_quote_html {s} { + regsub -all {&} $s {\&} s ;# must be first! + regsub -all {"} $s {\"} s + regsub -all {<} $s {\<} s + regsub -all {>} $s {\>} s + return $s +} + +proc cgi_dquote_html {s} { + return \"[cgi_quote_html $s]\" +} + +# return string quoted appropriately to appear in a url +proc cgi_quote_url {in} { + regsub -all {%} $in "%25" in + regsub -all {\+} $in "%2b" in + regsub -all { } $in "%20" in + regsub -all {"} $in "%22" in + regsub -all {\?} $in "%3f" in + return $in +} + +################################################## +# short or single paragraph support +################################################## + +proc cgi_br {args} { + cgi_put "<br" + if {[llength $args]} { + cgi_put "[_cgi_list_to_string $args]" + } + cgi_put " />" +} + +# generate cgi_h1 and others +for {set _cgi(tmp) 1} {$_cgi(tmp)<8} {incr _cgi(tmp)} { + proc cgi_h$_cgi(tmp) {{args}} "eval cgi_h $_cgi(tmp) \$args" +} +proc cgi_h {num args} { + cgi_put "<h$num" + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + set args [lrange $args end end] + } + cgi_put ">[lindex $args 0]</h$num>" +} + +proc cgi_p {args} { + cgi_put "<p" + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + set args [lrange $args end end] + } + cgi_put ">[lindex $args 0]</p>" +} + +proc cgi_address {s} {cgi_put <address>$s</address>} +proc cgi_blockquote {s} {cgi_puts <blockquote>$s</blockquote>} + +################################################## +# long or multiple paragraph support +################################################## + +# Shorthand for <div align=center>. We used to use <center> tags but that +# is now officially unsupported. +proc cgi_center {cmd} { + uplevel 1 "cgi_division align=center [list $cmd]" +} + +proc cgi_division {args} { + cgi_put "<div" + _cgi_close_proc_push "cgi_put </div>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr {[llength $args]-2}]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_preformatted {args} { + cgi_put "<pre" + _cgi_close_proc_push "cgi_put </pre>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +################################################## +# list support +################################################## + +proc cgi_li {args} { + cgi_put <li + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">[lindex $args end]</li>" +} + +proc cgi_number_list {args} { + cgi_put "<ol" + _cgi_close_proc_push "cgi_put </ol>" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_bullet_list {args} { + cgi_put "<ul" + _cgi_close_proc_push "cgi_put </ul>" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +# Following two are normally used from within definition lists +# but are actually paragraph types on their own. +proc cgi_term {s} {cgi_put <dt>$s</dt>} +proc cgi_term_definition {s} {cgi_put <dd>$s</dd>} + +proc cgi_definition_list {cmd} { + cgi_put "<dl>" + _cgi_close_proc_push "cgi_put </dl>" + + uplevel 1 $cmd + _cgi_close_proc +} + +proc cgi_menu_list {cmd} { + cgi_put "<menu>" + _cgi_close_proc_push "cgi_put </menu>" + + uplevel 1 $cmd + _cgi_close_proc +} +proc cgi_directory_list {cmd} { + cgi_put "<dir>" + _cgi_close_proc_push "cgi_put </dir>" + + uplevel 1 $cmd + _cgi_close_proc +} + +################################################## +# text support +################################################## + +proc cgi_put {s} {cgi_puts -nonewline $s} + +# some common special characters +proc cgi_lt {} {return "<"} +proc cgi_gt {} {return ">"} +proc cgi_amp {} {return "&"} +proc cgi_quote {} {return """} +proc cgi_enspace {} {return " "} +proc cgi_emspace {} {return " "} +proc cgi_nbspace {} {return " "} ;# nonbreaking space +proc cgi_tm {} {return "®"} ;# registered trademark +proc cgi_copyright {} {return "©"} +proc cgi_isochar {n} {return "&#$n;"} +proc cgi_breakable {} {return "<wbr />"} + +proc cgi_unbreakable_string {s} {return "<nobr>$s</nobr>"} +proc cgi_unbreakable {cmd} { + cgi_put "<nobr>" + _cgi_close_proc_push "cgi_put </nobr>" + uplevel 1 $cmd + _cgi_close_proc +} + +proc cgi_nl {args} { + set buf "<br" + if {[llength $args]} { + append buf "[_cgi_list_to_string $args]" + } + return "$buf />" +} + +proc cgi_bold {s} {return "<b>$s</b>"} +proc cgi_italic {s} {return "<i>$s</i>"} +proc cgi_underline {s} {return "<u>$s</u>"} +proc cgi_strikeout {s} {return "<s>$s</s>"} +proc cgi_subscript {s} {return "<sub>$s</sub>"} +proc cgi_superscript {s} {return "<sup>$s</sup>"} +proc cgi_typewriter {s} {return "<tt>$s</tt>"} +proc cgi_blink {s} {return "<blink>$s</blink>"} +proc cgi_emphasis {s} {return "<em>$s</em>"} +proc cgi_strong {s} {return "<strong>$s</strong>"} +proc cgi_cite {s} {return "<cite>$s</cite>"} +proc cgi_sample {s} {return "<samp>$s</samp>"} +proc cgi_keyboard {s} {return "<kbd>$s</kbd>"} +proc cgi_variable {s} {return "<var>$s</var>"} +proc cgi_definition {s} {return "<dfn>$s</dfn>"} +proc cgi_big {s} {return "<big>$s</big>"} +proc cgi_small {s} {return "<small>$s</small>"} + +proc cgi_basefont {size} {cgi_put "<basefont size=$size />"} + +proc cgi_font {args} { + global _cgi + + set buf "<font" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf>[lindex $args end]</font>" +} + +# take a cgi func and have it return what would normally print +# This command is reentrant (that's why it's so complex). +proc cgi_buffer {cmd} { + global _cgi + + if {0==[info exists _cgi(returnIndex)]} { + set _cgi(returnIndex) 0 + } + + rename cgi_puts cgi_puts$_cgi(returnIndex) + incr _cgi(returnIndex) + set _cgi(return[set _cgi(returnIndex)]) "" + + proc cgi_puts args { + global _cgi + upvar #0 _cgi(return[set _cgi(returnIndex)]) buffer + + append buffer [lindex $args end] + if {[llength $args] == 1} { + append buffer $_cgi(buffer_nl) + } + } + + # must restore things before allowing the eval to fail + # so catch here and rethrow later + if {[catch {uplevel 1 $cmd} errMsg]} { + global errorInfo + set savedInfo $errorInfo + } + + # not necessary to put remainder of code in close_proc_push since it's + # all buffered anyway and hasn't yet put browser into a funky state. + + set buffer $_cgi(return[set _cgi(returnIndex)]) + + incr _cgi(returnIndex) -1 + rename cgi_puts "" + rename cgi_puts$_cgi(returnIndex) cgi_puts + + if {[info exists savedInfo]} { + error $errMsg $savedInfo + } + return $buffer +} + +set _cgi(buffer_nl) "\n" +proc cgi_buffer_nl {nl} { + global _cgi + + set old $_cgi(buffer_nl) + set _cgi(buffer_nl) $nl + return $old +} + +################################################## +# html and tags that can appear in html top-level +################################################## + +proc cgi_html {args} { + set html [lindex $args end] + set argc [llength $args] + if {$argc > 1} { + eval _cgi_html_start [lrange $args 0 [expr {$argc-2}]] + } else { + _cgi_html_start + } + uplevel 1 $html + _cgi_html_end +} + +proc _cgi_html_start {args} { + global _cgi + + if {[info exists _cgi(html_in_progress)]} return + _cgi_http_head_implicit + + set _cgi(html_in_progress) 1 + cgi_doctype + + append buf "<html" + foreach a $args { + if {[regexp $_cgi(attr,regexp) $a dummy attr str]} { + append buf " $attr=\"$str\"" + } else { + append buf " $a" + } + } + cgi_puts "$buf>" +} + +proc _cgi_html_end {} { + global _cgi + unset _cgi(html_in_progress) + set _cgi(html_done) 1 + cgi_puts "</html>" +} + +# force closure of all tags and exit without going through normal returns. +# Very useful if you want to call exit from a deeply stacked CGI script +# and still have the HTML be correct. +proc cgi_exit {} { + _cgi_close_procs + cgi_html {cgi_body {}} + exit +} + +################################################## +# head support +################################################## + +proc cgi_head {{head {}}} { + global _cgi + + if {[info exists _cgi(head_done)]} { + return + } + + # allow us to be recalled so that we can display errors + if {0 == [info exists _cgi(head_in_progress)]} { + _cgi_http_head_implicit + set _cgi(head_in_progress) 1 + cgi_puts "<head>" + } + + # prevent cgi_html (during error handling) from generating html tags + set _cgi(html_in_progress) 1 + # don't actually generate html tags since there's nothing to clean + # them up + + if {0 == [string length $head]} { + if {[catch {cgi_title}]} { + set head "cgi_title untitled" + } + } + uplevel 1 $head + if {![info exists _cgi(head_suppress_tag)]} { + cgi_puts "</head>" + } else { + unset _cgi(head_suppress_tag) + } + + set _cgi(head_done) 1 + + # debugging can unset this in the uplevel above + catch {unset _cgi(head_in_progress)} +} + +# with one arg: set, print, and return title +# with no args: return title +proc cgi_title {args} { + global _cgi + + set title [lindex $args 0] + + if {[llength $args]} { + _cgi_http_head_implicit + + # we could just generate <head></head> tags, but head-level commands + # might follow so just suppress the head tags entirely + if {![info exists _cgi(head_in_progress)]} { + set _cgi(head_in_progress) 1 + set _cgi(head_suppress_tag) 1 + } + + set _cgi(title) $title + cgi_puts "<title>$title</title>" + } + return $_cgi(title) +} + +# This tag can only be called from with cgi_head. +# example: cgi_http_equiv Refresh 1 +# There's really no reason to call this since it can be done directly +# from cgi_http_head. +proc cgi_http_equiv {type contents} { + _cgi_http_head_implicit + cgi_puts "<meta http-equiv=\"$type\" content=[cgi_dquote_html $contents]/>" +} + +# Do whatever you want with meta tags. +# Example: <meta name="author" content="Don Libes"> +proc cgi_meta {args} { + cgi_put "<meta" + foreach a $args { + if {[regexp "^(name|content|http-equiv)=(.*)" $a dummy attr str]} { + cgi_put " $attr=[cgi_dquote_html $str]" + } else { + cgi_put " $a" + } + } + cgi_puts " />" +} + +proc cgi_relationship {rel href args} { + cgi_puts "<link rel=$rel href=\"$href\"" + foreach a $args { + if {[regexp "^title=(.*)" $a dummy str]} { + cgi_put " title=[cgi_dquote_html $str]" + } elseif {[regexp "^type=(.*)" $a dummy str]} { + cgi_put " type=[cgi_dquote_html $str]" + } else { + cgi_put " $a" + } + } + cgi_puts "/>" +} + +proc cgi_name {args} { + global _cgi + + if {[llength $args]} { + set _cgi(name) [lindex $args 0] + } + return $_cgi(name) +} + +################################################## +# body and other top-level support +################################################## + +proc cgi_body {args} { + global errorInfo errorCode _cgi + + # allow user to "return" from the body without missing _cgi_body_end + if {1==[catch { + eval _cgi_body_start [lrange $args 0 [expr [llength $args]-2]] + uplevel 1 [lindex $args end] + } errMsg]} { + set savedInfo $errorInfo + set savedCode $errorCode + error $errMsg $savedInfo $savedCode + } + _cgi_body_end +} + +proc _cgi_body_start {args} { + global _cgi + if {[info exists _cgi(body_in_progress)]} return + + cgi_head + + set _cgi(body_in_progress) 1 + + cgi_put "<body" + foreach a "$args $_cgi(body_args)" { + if {[regexp "^(background|bgcolor|text|link|vlink|alink|onLoad|onUnload)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts ">" + + cgi_debug { + global env + catch {cgi_puts "Input: <pre>$_cgi(input)</pre>"} + catch {cgi_puts "Cookie: <pre>$env(HTTP_COOKIE)</pre>"} + } + + if {![info exists _cgi(errorInfo)]} { + uplevel 2 app_body_start + } +} + +proc _cgi_body_end {} { + global _cgi + if {![info exists _cgi(errorInfo)]} { + uplevel 2 app_body_end + } + unset _cgi(body_in_progress) + cgi_puts "</body>" + + if {[info exists _cgi(multipart)]} { + unset _cgi(http_head_done) + catch {unset _cgi(http_status_done)} + unset _cgi(head_done) + catch {unset _cgi(head_suppress_tag)} + } +} + +proc cgi_body_args {args} { + global _cgi + + set _cgi(body_args) $args +} + +proc cgi_script {args} { + cgi_puts "<script[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + _cgi_close_proc_push "cgi_puts </script>" + + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_javascript {args} { + cgi_puts "<script[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + cgi_puts "<!--- Hide script from browsers that don't understand JavaScript" + _cgi_close_proc_push {cgi_puts "// End hiding -->\n</script>"} + + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_noscript {args} { + cgi_puts "<noscript[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + _cgi_close_proc_push {cgi_puts "</noscript>"} + + uplevel 1 [lindex $args end] + + _cgi_close_proc +} + +proc cgi_applet {args} { + cgi_puts "<applet[_cgi_lrange $args 0 [expr [llength $args]-2]]>" + _cgi_close_proc_push "cgi_puts </applet>" + + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_param {nameval} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + if {$q != "="} { + set value "" + } + cgi_puts "<param name=\"$name\" value=[cgi_dquote_html $value]/>" +} + +# record any proc's that must be called prior to displaying an error +proc _cgi_close_proc_push {p} { + global _cgi + if {![info exists _cgi(close_proc)]} { + set _cgi(close_proc) "" + } + set _cgi(close_proc) "$p; $_cgi(close_proc)" +} + +proc _cgi_close_proc_pop {} { + global _cgi + regexp "^(\[^;]*);(.*)" $_cgi(close_proc) dummy lastproc _cgi(close_proc) + return $lastproc +} + +# generic proc to close whatever is on the top of the stack +proc _cgi_close_proc {} { + eval [_cgi_close_proc_pop] +} + +proc _cgi_close_procs {} { + global _cgi + + _cgi_close_tag + if {[info exists _cgi(close_proc)]} { + uplevel #0 $_cgi(close_proc) + } +} + +proc _cgi_close_tag {} { + global _cgi + + if {[info exists _cgi(tag_in_progress)]} { + cgi_put ">" + unset _cgi(tag_in_progress) + } +} + +################################################## +# hr support +################################################## + +proc cgi_hr {args} { + set buf "<hr" + foreach a $args { + if {[regexp "^width=(.*)" $a dummy str]} { + append buf " width=\"$str\"" + } else { + append buf " $a" + } + } + cgi_put "$buf />" +} + +################################################## +# form & isindex +################################################## + +proc cgi_form {action args} { + global _cgi + + _cgi_form_multiple_check + set _cgi(form_in_progress) 1 + + _cgi_close_proc_push _cgi_form_end + cgi_put "<form action=" + if {[regexp {^[a-z]*:} $action]} { + cgi_put "\"$action\"" + } else { + cgi_put "\"[cgi_cgi $action]\"" + } + set method "method=post" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "^method=" $a]} { + set method $a + } elseif {[regexp "^(target|onReset|onSubmit)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } elseif {[regexp "^enctype=(.*)" $a dummy str]} { + cgi_put " enctype=\"$str\"" + set _cgi(form,enctype) $str + } else { + cgi_put " $a" + } + } + cgi_put " $method>" + uplevel 1 [lindex $args end] + catch {unset _cgi(form,enctype)} + _cgi_close_proc +} + +proc _cgi_form_end {} { + global _cgi + unset _cgi(form_in_progress) + cgi_put "</form>" +} + +proc _cgi_form_multiple_check {} { + global _cgi + if {[info exists _cgi(form_in_progress)]} { + error "Cannot create form (or isindex) with form already in progress." + } +} + +proc cgi_isindex {args} { + _cgi_form_multiple_check + + cgi_put "<isindex" + foreach a $args { + if {[regexp "^href=(.*)" $a dummy str]} { + cgi_put " href=\"$str\"" + } elseif {[regexp "^prompt=(.*)" $a dummy str]} { + cgi_put " prompt=[cgi_dquote_html $str]" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# argument handling +################################################## + +proc cgi_input {{fakeinput {}} {fakecookie {}}} { + global env _cgi _cgi_uservar _cgi_cookie _cgi_cookie_shadowed + + set _cgi(uservars) {} + set _cgi(uservars,autolist) {} + + if {[info exists env(CONTENT_TYPE)] && [regexp ^multipart/form-data $env(CONTENT_TYPE)]} { + if {![info exists env(REQUEST_METHOD)]} { + # running by hand + set fid [open $fakeinput] + } else { + set fid stdin + } + if {([info tclversion] >= 8.1) || [catch exp_version] || [info exists _cgi(no_binary_upload)]} { + _cgi_input_multipart $fid + } else { + _cgi_input_multipart_binary $fid + } + } else { + if {![info exists env(REQUEST_METHOD)]} { + set input $fakeinput + set env(HTTP_COOKIE) $fakecookie + } elseif { $env(REQUEST_METHOD) == "GET" } { + set input "" + catch {set input $env(QUERY_STRING)} ;# doesn't have to be set + } elseif { $env(REQUEST_METHOD) == "HEAD" } { + set input "" + } elseif {![info exists env(CONTENT_LENGTH)]} { + set _cgi(client_error) 1 + error "Your browser failed to generate the content-length during a POST method." + } else { + set length $env(CONTENT_LENGTH) + if {0!=[string compare $length "-1"]} { + set input [read stdin $env(CONTENT_LENGTH)] + } else { + set _cgi(client_error) 1 + error "Your browser generated a content-length of -1 during a POST method." + } + if {[info tclversion] >= 8.1} { + # guess query encoding from Content-Type header + if {[info exists env(CONTENT_TYPE)] \ + && [regexp -nocase -- {charset=([^[:space:]]+)} $env(CONTENT_TYPE) m cs]} { + if {[regexp -nocase -- {iso-?8859-([[:digit:]]+)} $cs m d]} { + set _cgi(queryencoding) "iso8859-$d" + } elseif {[regexp -nocase -- {windows-([[:digit:]]+)} $cs m d]} { + set _cgi(queryencoding) "cp$d" + } elseif {0==[string compare -nocase $cs "utf-8"]} { + set _cgi(queryencoding) "utf-8" + } elseif {0==[string compare -nocase $cs "utf-16"]} { + set _cgi(queryencoding) "unicode" + } + } else { + set _cgi(queryencoding) [encoding system] + } + } + } + # save input for possible diagnostics later + set _cgi(input) $input + + set pairs [split $input &] + foreach pair $pairs { + if {0 == [regexp "^(\[^=]*)=(.*)$" $pair dummy varname val]} { + # if no match, unquote and leave it at that + # this is typical of <isindex>-style queries + set varname anonymous + set val $pair + } + + set varname [cgi_unquote_input $varname] + set val [cgi_unquote_input $val] + _cgi_set_uservar $varname $val + } + } + + # O'Reilly's web server incorrectly uses COOKIE + catch {set env(HTTP_COOKIE) $env(COOKIE)} + if {![info exists env(HTTP_COOKIE)]} return + foreach pair [split $env(HTTP_COOKIE) ";"] { + # pairs are actually split by "; ", sigh + set pair [string trimleft $pair " "] + # spec is not clear but seems to allow = unencoded + # only sensible interpretation is to assume no = in var names + # appears MS IE can omit "=val" + set val "" + regexp (\[^=]*)=?(.*) $pair dummy varname val + + set varname [cgi_unquote_input $varname] + set val [cgi_unquote_input $val] + + if {[info exists _cgi_cookie($varname)]} { + lappend _cgi_cookie_shadowed($varname) $val + } else { + set _cgi_cookie($varname) $val + } + } +} + +proc _cgi_input_multipart {fin} { + global env _cgi _cgi_uservar _cgi_userfile + + cgi_debug -noprint { + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + # explicitly flush all writes to fout, because sometimes the writer + # can hang and we won't get to the termination code + set dbg_fout [open $dbg_filename w $_cgi(tmpperms)] + set _cgi(input) $dbg_filename + catch {fconfigure $dbg_fout -translation binary} + } + + # figure out boundary + if {0==[regexp boundary=(.*) $env(CONTENT_TYPE) dummy boundary]} { + set _cgi(client_error) 1 + error "Your browser failed to generate a \"boundary=\" line in a multipart response (CONTENT_TYPE: $env(CONTENT_TYPE)). Please upgrade (or fix) your browser." + } + + # make boundary into a legal regsub pattern by protecting # + # legal boundary characters include ()+.? (among others) + regsub -all "\\(" $boundary "\\(" boundary + regsub -all "\\)" $boundary "\\)" boundary + regsub -all "\\+" $boundary "\\+" boundary + regsub -all "\\." $boundary "\\." boundary + regsub -all "\\?" $boundary "\\?" boundary + + set boundary --$boundary + + # don't corrupt or modify uploads yet allow Tcl 7.4 to work + catch {fconfigure $fin -translation binary} + + # get first boundary line + gets $fin buf + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + + set _cgi(file,filecount) 0 + + while {1} { + # process Content-Disposition: + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + catch {unset filename} + regexp {name="([^"]*)"} $buf dummy varname + if {0==[info exists varname]} { + # lynx violates spec and doesn't use quotes, so try again but + # assume space is delimiter + regexp {name=([^ ]*)} $buf dummy varname + if {0==[info exists varname]} { + set _cgi(client_error) 1 + error "In response to a request for a multipart form, your browser generated a part header without a name field. Please upgrade (or fix) your browser." + } + } + # Lame-o encoding (on Netscape at least) doesn't escape field + # delimiters (like quotes)!! Since all we've ever seen is filename= + # at end of line, assuming nothing follows. Sigh. + regexp {filename="(.*)"} $buf dummy filename + + # Skip remaining headers until blank line. + # Content-Type: can appear here. + set conttype "" + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + if {0==[string compare $buf "\r"]} break + regexp -nocase "^Content-Type:\[ \t]+(.*)\r" $buf x conttype + } + + if {[info exists filename]} { + if {$_cgi(file,filecount) > $_cgi(file,filelimit)} { + error "Too many files submitted. Max files allowed: $_cgi(file,filelimit)" + } + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] + set fout [open $foutname w $_cgi(tmpperms)] + # "catch" permits this to work with Tcl 7.4 + catch {fconfigure $fout -translation binary} + _cgi_set_uservar $varname [list $foutname $filename $conttype] + set _cgi_userfile($varname) [list $foutname $filename $conttype] + + # + # Look for a boundary line preceded by \r\n. + # + # To do this, we buffer line terminators that might + # be the start of the special \r\n$boundary sequence. + # The buffer is called "leftover" and is just inserted + # into the front of the next output (assuming it's + # not a boundary line). + + set leftover "" + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + + if {0 == [string compare "\r\n" $leftover]} { + if {[regexp ^[set boundary](--)?\r?$ $buf dummy dashdash]} { + if {$dashdash == "--"} {set eof 1} + break + } + } + if {[regexp (.*)\r$ $buf x data]} { + puts -nonewline $fout $leftover$data + set leftover "\r\n" + } else { + puts -nonewline $fout $leftover$buf + set leftover "\n" + } + if {[file size $foutname] > $_cgi(file,charlimit)} { + error "File size exceeded. Max file size allowed: $_cgi(file,charlimit)" + } + } + + close $fout + unset fout + } else { + # read the part into a variable + set val "" + set blanks 0 + while {1} { + if {-1 == [gets $fin buf]} break + if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout} + if {[regexp ^[set boundary](--)?\r?$ $buf dummy dashdash]} { + if {$dashdash == "--"} {set eof 1} + break + } + if {0!=[string compare $val ""]} { + append val \n + } + regexp (.*)\r$ $buf dummy buf + if {[info exists blanks]} { + if {0!=[string compare $buf ""]} { + if {$blanks} { + append val [string repeat \n [incr blanks]] + } + unset blanks + } else { + incr blanks + } + } + append val $buf + } + _cgi_set_uservar $varname $val + } + if {[info exists eof]} break + } + if {[info exists dbg_fout]} {close $dbg_fout} +} + +proc _cgi_input_multipart_binary {fin} { + global env _cgi _cgi_uservar _cgi_userfile + + log_user 0 + set timeout -1 + + cgi_debug -noprint { + # save file for debugging purposes + set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]] + set _cgi(input) $dbg_filename + spawn -open [open $dbg_filename w $_cgi(tmpperms)] + set dbg_sid $spawn_id + } + spawn -open $fin + set fin_sid $spawn_id + remove_nulls 0 + + if {0} { + # dump input to screen + cgi_debug { + puts "<xmp>" + expect { + -i $fin_sid + -re ^\r {puts -nonewline "CR"; exp_continue} + -re ^\n {puts "NL"; exp_continue} + -re . {puts -nonewline $expect_out(buffer); exp_continue} + } + puts "</xmp>" + exit + } + } + + # figure out boundary + if {0==[regexp boundary=(.*) $env(CONTENT_TYPE) dummy boundary]} { + set _cgi(client_error) 1 + error "Your browser failed to generate a \"boundary=\" definition in a multipart response (CONTENT_TYPE: $env(CONTENT_TYPE)). Please upgrade (or fix) your browser." + } + + # make boundary into a legal regsub pattern by protecting # + # legal boundary characters include ()+.? (among others) + regsub -all "\\(" $boundary "\\(" boundary + regsub -all "\\)" $boundary "\\)" boundary + regsub -all "\\+" $boundary "\\+" boundary + regsub -all "\\." $boundary "\\." boundary + regsub -all "\\?" $boundary "\\?" boundary + + set boundary --$boundary + set linepat "(\[^\r]*)\r\n" + + # get first boundary line + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + } + eof { + set _cgi(client_error) 1 + error "Your browser failed to provide an initial boundary ($boundary) in a multipart response. Please upgrade (or fix) your browser." + } + } + + set _cgi(file,filecount) 0 + + while {1} { + # process Content-Disposition: + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + } + eof break + } + catch {unset filename} + regexp {name="([^"]*)"} $buf dummy varname + if {0==[info exists varname]} { + set _cgi(client_error) 1 + error "In response to a request for a multipart form, your browser generated a part header without a name field. Please upgrade (or fix) your browser." + } + + # Lame-o encoding (on Netscape at least) doesn't escape field + # delimiters (like quotes)!! Since all we've ever seen is filename= + # at end of line, assuming nothing follows. Sigh. + regexp {filename="(.*)"} $buf dummy filename + + # Skip remaining headers until blank line. + # Content-Type: can appear here. + set conttype "" + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + if {0!=[string compare $buf ""]} exp_continue + regexp -nocase "^Content-Type:\[ \t]+(.*)\r" $buf x conttype + } + eof break + } + + if {[info exists filename]} { + if {$_cgi(file,filecount) > $_cgi(file,filelimit)} { + error "Too many files submitted. Max files allowed: $_cgi(file,filelimit)" + } + + # read the part into a file + set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]] + spawn -open [open $foutname w $_cgi(tmpperms)] + set fout_sid $spawn_id + + _cgi_set_uservar $varname [list $foutname $filename $conttype] + set _cgi_userfile($varname) [list $foutname $filename $conttype] + + # This is tricky stuff - be very careful changing anything here! + # In theory, all we have to is record everything up to + # \r\n$boundary\r\n. Unfortunately, we can't simply wait on + # such a pattern because the input can overflow any possible + # buffer we might choose. We can't simply catch buffer_full + # because the boundary might straddle a buffer. I doubt that + # doing my own buffering would be any faster than taking the + # approach I've done here. + # + # The code below basically implements a simple scanner that + # keeps track of whether it's seen crlfs or pieces of them. + # The idea is that we look for crlf pairs, separated by + # things that aren't crlfs (or pieces of them). As we encounter + # things that aren't crlfs (or pieces of them), or when we decide + # they can't be, we mark them for output and resume scanning for + # new pairs. + # + # The scanner runs tolerably fast because the [...]+ pattern picks + # up most things. The \r and \n are ^-anchored so the pattern + # match is pretty fast and these don't happen that often so the + # huge \n action is executed rarely (once per line on text files). + # The null pattern is, of course, only used when everything + # else fails. + + # crlf == "\r\n" if we've seen one, else == "" + # cr == "\r" if we JUST saw one, else == "" + # Yes, strange, but so much more efficient + # that I'm willing to sacrifice readability, sigh. + # buf accumulated data between crlf pairs + + set buf "" + set cr "" + set crlf "" + + expect { + -i $fin_sid + -re "^\r" { + if {$cr == "\r"} { + append buf "\r" + } + set cr \r + exp_continue + } -re "^\n" { + if {$cr == "\r"} { + if {$crlf == "\r\n"} { + # do boundary test + if {[regexp ^[set boundary](--)?$ $buf dummy dashdash]} { + if {$dashdash == "--"} { + set eof 1 + } + } else { + # boundary test failed + if {[info exists dbg_sid]} {send -i $dbg_sid -- \r\n$buf} + send -i $fout_sid \r\n$buf ; set buf "" + set cr "" + exp_continue + } + } else { + set crlf "\r\n" + set cr "" + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf} + send -i $fout_sid -- $buf ; set buf "" + exp_continue + } + } else { + if {[info exists dbg_sid]} {send -i $dbg_sid -- $crlf$buf\n} + send -i $fout_sid -- $crlf$buf\n ; set buf "" + set crlf "" + exp_continue + } + } -re "\[^\r\n]+" { + if {$cr == "\r"} { + set buf $crlf$buf\r$expect_out(buffer) + set crlf "" + set cr "" + } else { + append buf $expect_out(buffer) + } + exp_continue + } null { + if {[info exists dbg_sid]} { + send -i $dbg_sid -- $crlf$buf$cr + send -i $dbg_sid -null + } + send -i $fout_sid -- $crlf$buf$cr ; set buf "" + send -i $fout_sid -null + set cr "" + set crlf "" + exp_continue + } eof { + set _cgi(client_error) 1 + error "Your browser failed to provide an ending boundary ($boundary) in a multipart response. Please upgrade (or fix) your browser." + } + } + exp_close -i $fout_sid ;# implicitly closes fout + exp_wait -i $fout_sid + unset fout_sid + } else { + # read the part into a variable + set val "" + expect { + -i $fin_sid + -re $linepat { + set buf $expect_out(1,string) + if {[info exists dbg_sid]} {send -i $dbg_sid -- $buf\n} + if {[regexp ^[set boundary](--)?$ $buf dummy dashdash]} { + if {$dashdash == "--"} {set eof 1} + } else { + regexp (.*)\r$ $buf dummy buf + if {0!=[string compare $val ""]} { + append val \n + } + append val $buf + exp_continue + } + } + } + _cgi_set_uservar $varname $val + } + if {[info exists eof]} break + } + if {[info exists fout]} { + exp_close -i $dbg_sid + exp_wait -i $dbg_sid + } + + # no need to close fin, fin_sid, or dbg_sid +} + +# internal routine for defining user variables +proc _cgi_set_uservar {varname val} { + global _cgi _cgi_uservar + + set exists [info exists _cgi_uservar($varname)] + set isList $exists + # anything we've seen before and is being set yet again necessarily + # has to be (or become a list) + + if {!$exists} { + lappend _cgi(uservars) $varname + } + + if {[regexp List$ $varname]} { + set isList 1 + } elseif {$exists} { + # vars that we've seen before but aren't marked as lists + # need to be "listified" so we can do appends later + if {-1 == [lsearch $_cgi(uservars,autolist) $varname]} { + # remember that we've listified it + lappend _cgi(uservars,autolist) $varname + set _cgi_uservar($varname) [list $_cgi_uservar($varname)] + } + } + if {$isList} { + lappend _cgi_uservar($varname) $val + } else { + set _cgi_uservar($varname) $val + } +} + +# export named variable +proc cgi_export {nameval} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + if {$q != "="} { + set value [uplevel 1 set [list $name]] + } + + cgi_put "<input type=hidden name=\"$name\" value=[cgi_dquote_html $value]/>" +} + +proc cgi_export_cookie {name args} { + upvar 1 $name x + eval cgi_cookie_set [list $name=$x] $args +} + +# return list of variables available for import +# Explicit list is used to keep items in order originally found in form. +proc cgi_import_list {} { + global _cgi + + return $_cgi(uservars) +} + +# import named variable +proc cgi_import {name} { + global _cgi_uservar + upvar 1 $name var + + set var $_cgi_uservar($name) +} + +proc cgi_import_as {name tclvar} { + global _cgi_uservar + upvar 1 $tclvar var + + set var $_cgi_uservar($name) +} + +# like cgi_import but if not available, try cookie +proc cgi_import_cookie {name} { + global _cgi_uservar + upvar 1 $name var + + if {0==[catch {set var $_cgi_uservar($name)}]} return + set var [cgi_cookie_get $name] +} + +# like cgi_import but if not available, try cookie +proc cgi_import_cookie_as {name tclvar} { + global _cgi_uservar + upvar 1 $tclvar var + + if {0==[catch {set var $_cgi_uservar($name)}]} return + set var [cgi_cookie_get $name] +} + +proc cgi_import_file {type name} { + global _cgi_userfile + upvar 1 $name var + + set var $_cgi_userfile($name) + switch -- $type { + "-server" { + lindex $var 0 + } "-client" { + lindex $var 1 + } "-type" { + lindex $var 2 + } + } +} + +# deprecated, use cgi_import_file +proc cgi_import_filename {type name} { + global _cgi_userfile + upvar 1 $name var + + set var $_cgi_userfile($name) + if {$type == "-server" || $type == "-local"} { + # -local is deprecated + lindex $var 0 + } else { + lindex $var 1 + } +} + +# set the urlencoding +proc cgi_urlencoding {{encoding ""}} { + global _cgi + + set result [expr {[info exists _cgi(queryencoding)] + ? $_cgi(queryencoding) + : ""}] + + # check if the encoding is available + if {[info tclversion] >= 8.1 + && [lsearch -exact [encoding names] $encoding] != -1 } { + set _cgi(queryencoding) $encoding + } + + return $result +} + +################################################## +# button support +################################################## + +# not sure about arg handling, do we need to support "name="? +proc cgi_button {value args} { + cgi_put "<input type=button value=[cgi_dquote_html $value]" + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +# Derive a button from a link predefined by cgi_link +proc cgi_button_link {args} { + global _cgi_link + + set tag [lindex $args 0] + if {[llength $args] == 2} { + set label [lindex $args end] + } else { + set label $_cgi_link($tag,label) + } + + cgi_button $label onClick=$_cgi_link($tag,url) +} + +proc cgi_submit_button {{nameval {=Submit Query}} args} { + regexp "(\[^=]*)=(.*)" $nameval dummy name value + cgi_put "<input type=submit" + if {0!=[string compare "" $name]} { + cgi_put " name=\"$name\"" + } + cgi_put " value=[cgi_dquote_html $value]" + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + + +proc cgi_reset_button {{value Reset} args} { + cgi_put "<input type=reset value=[cgi_dquote_html $value]" + + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +proc cgi_radio_button {nameval args} { + regexp "(\[^=]*)=(.*)" $nameval dummy name value + + cgi_put "<input type=radio name=\"$name\" value=[cgi_dquote_html $value]" + + foreach a $args { + if {[regexp "^checked_if_equal=(.*)" $a dummy default]} { + if {0==[string compare $default $value]} { + cgi_put " checked" + } + } elseif {[regexp "^checked=(.*)" $a dummy checked]} { + # test explicitly to avoid forcing user eval + if {$checked} { + cgi_put " checked" + } + } elseif {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +proc cgi_image_button {nameval args} { + regexp "(\[^=]*)=(.*)" $nameval dummy name value + cgi_put "<input type=image" + if {0!=[string compare "" $name]} { + cgi_put " name=\"$name\"" + } + cgi_put " src=\"$value\"" + foreach a $args { + if {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +# map/area implement client-side image maps +proc cgi_map {name cmd} { + cgi_put "<map name=\"$name\">" + _cgi_close_proc_push "cgi_put </map>" + + uplevel 1 $cmd + _cgi_close_proc +} + +proc cgi_area {args} { + cgi_put "<area" + foreach a $args { + if {[regexp "^(coords|shape|href|target|onMouseOut|alt)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# checkbox support +################################################## + +proc cgi_checkbox {nameval args} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + cgi_put "<input type=checkbox name=\"$name\"" + + if {0!=[string compare "" $value]} { + cgi_put " value=[cgi_dquote_html $value]" + } + + foreach a $args { + if {[regexp "^checked_if_equal=(.*)" $a dummy default]} { + if {0==[string compare $default $value]} { + cgi_put " checked" + } + } elseif {[regexp "^checked=(.*)" $a dummy checked]} { + # test explicitly to avoid forcing user eval + if {$checked} { + cgi_put " checked" + } + } elseif {[regexp "^onClick=(.*)" $a dummy str]} { + cgi_put " onClick=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# textentry support +################################################## + +proc cgi_text {nameval args} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + cgi_put "<input name=\"$name\"" + + if {$q != "="} { + set value [uplevel 1 set [list $name]] + } + cgi_put " value=[cgi_dquote_html $value]" + + foreach a $args { + if {[regexp "^on(Select|Focus|Blur|Change)=(.*)" $a dummy event str]} { + cgi_put " on$event=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put "/>" +} + +################################################## +# textarea support +################################################## + +proc cgi_textarea {nameval args} { + regexp "(\[^=]*)(=?)(.*)" $nameval dummy name q value + + cgi_put "<textarea name=\"$name\"" + foreach a $args { + if {[regexp "^on(Select|Focus|Blur|Change)=(.*)" $a dummy event str]} { + cgi_put " on$event=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_put ">" + + if {$q != "="} { + set value [uplevel 1 set [list $name]] + } + cgi_put "[cgi_quote_html $value]</textarea>" +} + +################################################## +# file upload support +################################################## + +# for this to work, pass enctype=multipart/form-data to cgi_form +proc cgi_file_button {name args} { + global _cgi + if {[info exists _cgi(formtype)] && ("multipart/form-data" != $_cgi(form,enctype))} { + error "cgi_file_button requires that cgi_form have the argument enctype=multipart/form-data" + } + cgi_put "<input type=file name=\"$name\"[_cgi_list_to_string $args]/>" +} + +# establish a per-file limit for uploads + +proc cgi_file_limit {files chars} { + global _cgi + + set _cgi(file,filelimit) $files + set _cgi(file,charlimit) $chars +} + +################################################## +# select support +################################################## + +proc cgi_select {name args} { + cgi_put "<select name=\"$name\"" + _cgi_close_proc_push "cgi_put </select>" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "^on(Focus|Blur|Change)=(.*)" $a dummy event str]} { + cgi_put " on$event=\"$str\"" + } else { + if {0==[string compare multiple $a]} { + ;# sanity check + if {![regexp "List$" $name]} { + cgi_puts ">" ;# prevent error from being absorbed + error "When selecting multiple options, select variable \ + must end in \"List\" to allow the value to be \ + recognized as a list when it is processed later." + } + } + cgi_put " $a" + } + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_option {o args} { + cgi_put "<option" + set value $o + set selected 0 + foreach a $args { + if {[regexp "^selected_if_equal=(.*)" $a dummy selected_if_equal]} { + } elseif {[regexp "^value=(.*)" $a dummy value]} { + cgi_put " value=[cgi_dquote_html $value]" + } else { + cgi_put " $a" + } + } + if {[info exists selected_if_equal]} { + if {0 == [string compare $selected_if_equal $value]} { + cgi_put " selected" + } + } + cgi_puts ">[cgi_quote_html $o]</option>" +} + +################################################## +# plug-in support +################################################## + +proc cgi_embed {src wh args} { + regexp (.*)x(.*) $wh dummy width height + cgi_put "<embed src=[cgi_dquote_html $src] width=\"$width\" height=\"$height\"" + foreach a $args { + if {[regexp "^palette=(.*)" $a dummy str]} { + cgi_put " palette=\"$str\"" + } elseif {[regexp -- "-quote" $a]} { + set quote 1 + } else { + if {[info exists quote]} { + regexp "(\[^=]*)=(.*)" $a dummy var val + cgi_put " var=[cgi_dquote_html $var]" + } else { + cgi_put " $a" + } + } + } + cgi_put "/>" +} + +################################################## +# mail support +################################################## + +# mail to/from the service itself +proc cgi_mail_addr {args} { + global _cgi + + if {[llength $args]} { + set _cgi(email) [lindex $args 0] + } + return $_cgi(email) +} + +proc cgi_mail_start {to} { + global _cgi + + set _cgi(mailfile) [file join $_cgi(tmpdir) cgimail.[pid]] + set _cgi(mailfid) [open $_cgi(mailfile) w+] + set _cgi(mailto) $to + + # mail is actually sent by "nobody". To force bounce messages + # back to us, override the default return-path. + cgi_mail_add "Return-Path: <$_cgi(email)>" + cgi_mail_add "From: [cgi_name] <$_cgi(email)>" + cgi_mail_add "To: $to" +} + +# add another line to outgoing mail +# if no arg, add a blank line +proc cgi_mail_add {{arg {}}} { + global _cgi + + puts $_cgi(mailfid) $arg +} + +# end the outgoing mail and send it +proc cgi_mail_end {} { + global _cgi + + flush $_cgi(mailfid) + + foreach sendmail in $_cgi(sendmail) { + if {[file executable $sendmail]} { + exec $sendmail -t -odb < $_cgi(mailfile) + # Explanation: + # -t means: pick up recipient from body + # -odb means: deliver in background + # note: bogus local address cause sendmail to fail immediately + set sent 1 + } + } + + if {0==[info exists sent]} { + # fallback for sites without sendmail + + if {0==[info exists _cgi(mail_relay)]} { + regexp "@(.*)" $_cgi(mailto) dummy _cgi(mail_relay) + } + + set s [socket $_cgi(mail_relay) 25] + gets $s answer + if {[lindex $answer 0] != 220} {error $answer} + + puts $s "HELO [info host]";flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + puts $s "MAIL FROM:<$_cgi(email)>";flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + puts $s "RCPT TO:<$_cgi(mailto)>";flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + puts $s DATA;flush $s + gets $s answer + if {[lindex $answer 0] != 354} {error $answer} + + seek $_cgi(mailfid) 0 start + puts $s [read $_cgi(mailfid)];flush $s + puts $s .;flush $s + gets $s answer + if {[lindex $answer 0] != 250} {error $answer} + + close $s + } + close $_cgi(mailfid) + file delete -force $_cgi(mailfile) +} + +proc cgi_mail_relay {host} { + global _cgi + + set _cgi(mail_relay) $host +} + +proc cgi_sendmail {path} { + global _cgi + + set _cgi(sendmail) $path +} + +################################################## +# cookie support +################################################## + +# calls to cookie_set look like this: +# cgi_cookie_set user=don domain=nist.gov expires=never +# cgi_cookie_set user=don domain=nist.gov expires=now +# cgi_cookie_set user=don domain=nist.gov expires=...actual date... + +proc cgi_cookie_set {nameval args} { + global _cgi + + if {![info exists _cgi(http_head_in_progress)]} { + error "Cookies must be set from within cgi_http_head." + } + cgi_puts -nonewline "Set-Cookie: [cgi_cookie_encode $nameval];" + + foreach a $args { + if {[regexp "^expires=(.*)" $a dummy expiration]} { + if {0==[string compare $expiration "never"]} { + set expiration "Friday, 11-Jan-2038 23:59:59 GMT" + } elseif {0==[string compare $expiration "now"]} { + set expiration "Friday, 31-Dec-1990 23:59:59 GMT" + } + cgi_puts -nonewline " expires=$expiration;" + } elseif {[regexp "^(domain|path)=(.*)" $a dummy attr str]} { + cgi_puts -nonewline " $attr=[cgi_cookie_encode $str];" + } elseif {[regexp "^secure$" $a]} { + cgi_puts -nonewline " secure;" + } + } + cgi_puts "" +} + +# return list of cookies available for import +proc cgi_cookie_list {} { + global _cgi_cookie + + array names _cgi_cookie +} + +proc cgi_cookie_get {args} { + global _cgi_cookie + + set all 0 + + set flag [lindex $args 0] + if {$flag == "-all"} { + set args [lrange $args 1 end] + set all 1 + } + set name [lindex $args 0] + + if {$all} { + global _cgi_cookie_shadowed + + if {[info exists _cgi_cookie_shadowed($name)]} { + return [concat $_cgi_cookie($name) $_cgi_cookie_shadowed($name)] + } else { + return [concat $_cgi_cookie($name)] + } + } + return $_cgi_cookie($name) +} + +proc cgi_cookie_encode {in} { + regsub -all " " $in "+" in + regsub -all "%" $in "%25" in ;# must preceed other subs that produce % + regsub -all ";" $in "%3B" in + regsub -all "," $in "%2C" in + regsub -all "\n" $in "%0D%0A" in + return $in +} + +################################################## +# table support +################################################## + +proc cgi_table {args} { + cgi_put "<table" + _cgi_close_proc_push "cgi_put </table>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_caption {args} { + cgi_put "<caption" + _cgi_close_proc_push "cgi_put </caption>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_table_row {args} { + cgi_put "<tr" + _cgi_close_proc_push "cgi_put </tr>" + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +# like table_row but without eval +proc cgi_tr {args} { + cgi_put <tr + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + foreach i [lindex $args end] { + cgi_td $i + } + cgi_put </tr> +} + +proc cgi_table_head {args} { + cgi_put "<th" + _cgi_close_proc_push "cgi_put </th>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +# like table_head but without eval +proc cgi_th {args} { + cgi_put "<th" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">[lindex $args end]</th>" +} + +proc cgi_table_data {args} { + cgi_put "<td" + _cgi_close_proc_push "cgi_put </td>" + + if {[llength $args]} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +# like table_data but without eval +proc cgi_td {args} { + cgi_put "<td" + + if {[llength $args] > 1} { + cgi_put "[_cgi_lrange $args 0 [expr [llength $args]-2]]" + } + cgi_put ">[lindex $args end]</td>" +} + +################################################## +# stylesheets - not yet documented +################################################## + +proc cgi_stylesheet {href} { + cgi_puts "<link rel=stylesheet href=\"$href\" type=\"text/css\"/>" +} + +proc cgi_span {args} { + set buf "<span" + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "style=(.*)" $a dummy str]} { + append buf " style=\"$str\"" + } elseif {[regexp "class=(.*)" $a dummy str]} { + append buf " class=\"$str\"" + } else { + append buf " $a" + } + } + return "$buf>[lindex $args end]</span>" +} + +################################################## +# frames +################################################## + +proc cgi_frameset {args} { + cgi_head ;# force it out, just in case none + + cgi_put "<frameset" + _cgi_close_proc_push "cgi_puts </frameset>" + + foreach a [lrange $args 0 [expr [llength $args]-2]] { + if {[regexp "^(rows|cols|onUnload|onLoad|onBlur)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts ">" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +proc cgi_frame {namesrc args} { + cgi_put "<frame" + + regexp "(\[^=]*)(=?)(.*)" $namesrc dummy name q src + + if {$name != ""} { + cgi_put " name=\"$name\"" + } + + if {$src != ""} { + cgi_put " src=\"$src\"" + } + + foreach a $args { + if {[regexp "^(marginwidth|marginheight|scrolling|onFocus)=(.*)" $a dummy attr str]} { + cgi_put " $attr=\"$str\"" + } else { + cgi_put " $a" + } + } + cgi_puts "/>" +} + +proc cgi_noframes {args} { + cgi_puts "<noframes>" + _cgi_close_proc_push "cgi_puts </noframes>" + uplevel 1 [lindex $args end] + _cgi_close_proc +} + +################################################## +# admin support +################################################## + +# mail address of the administrator +proc cgi_admin_mail_addr {args} { + global _cgi + + if {[llength $args]} { + set _cgi(admin_email) [lindex $args 0] + } + return $_cgi(admin_email) +} + +################################################## +# if possible, make each cmd available without cgi_ prefix +################################################## + +if {[info tclversion] >= 7.5} { + foreach _cgi(old) [info procs cgi_*] { + regexp "^cgi_(.*)" $_cgi(old) _cgi(dummy) _cgi(new) + if {[llength [info commands $_cgi(new)]]} continue + interp alias {} $_cgi(new) {} $_cgi(old) + } +} else { + foreach _cgi(old) [info procs cgi_*] { + regexp "^cgi_(.*)" $_cgi(old) _cgi(dummy) _cgi(new) + if {[llength [info commands $_cgi(new)]]} continue + proc $_cgi(new) {args} "uplevel 1 $_cgi(old) \$args" + } +} + +################################################## +# internal utilities +################################################## + +# undo Tcl's quoting due to list protection +# This leaves a space at the beginning if the string is non-null +# but this is always desirable in the HTML context in which it is called +# and the resulting HTML looks more readable. +# (It makes the Tcl callers a little less readable - however, there aren't +# more than a handful and they're all right here, so we'll live with it.) +proc _cgi_list_to_string {list} { + set string "" + foreach l $list { + append string " $l" + } + # remove first space if possible + # regexp "^ ?(.*)" $string dummy string + return $string +} + +# do lrange but return as string +# needed for stuff like: cgi_puts "[_cgi_lrange $args ...] +# Like _cgi_list_to_string, also returns string with initial blank if non-null +proc _cgi_lrange {list i1 i2} { + _cgi_list_to_string [lrange $list $i1 $i2] +} + +################################################## +# temporary file procedures +################################################## + +# set appropriate temporary file modes +proc cgi_tmpfile_permissions {{mode ""}} { + global _cgi + + if {[string length $mode]} { + set _cgi(tmpperms) $mode + } + + return $_cgi(tmpperms) +} + +################################################## +# user-defined procedures +################################################## + +# User-defined procedure called immediately after <body> +# Good mechanism for controlling things such as if all of your pages +# start with the same graphic or other boilerplate. +proc app_body_start {} {} + +# User-defined procedure called just before </body> +# Good place to generate signature lines, last-updated-by, etc. +proc app_body_end {} {} + +proc cgi_puts {args} { + eval puts $args +} + +# User-defined procedure to generate DOCTYPE declaration +proc cgi_doctype {} {} + +################################################## +# do some initialization +################################################## + +# cgi_init initializes to a known state. + +proc cgi_init {} { + global _cgi + unset _cgi + + # set explicitly for speed + set _cgi(debug) -off + set _cgi(buffer_nl) "\n" + + cgi_name "" + cgi_root "" + cgi_body_args "" + cgi_file_limit 10 100000000 + + if {[info tclversion] >= 8.1} { + # set initial urlencoding + if { [lsearch -exact [encoding names] "utf-8"] != -1} { + cgi_urlencoding "utf-8" + } else { + cgi_urlencoding [encoding system] + } + } + + # email addr of person responsible for this service + cgi_admin_mail_addr "root" ;# you should override this! + + # most services won't have an actual email addr + cgi_mail_addr "CGI script - do not reply" +} +cgi_init + +# deduce tmp directory +switch $tcl_platform(platform) { + unix { + set _cgi(tmpdir) /tmp + set _cgi(tmpperms) 0644 + set _cgi(sendmail) [list /usr/lib/sendmail /usr/sbin/sendmail] + } macintosh { + set _cgi(tmpdir) [pwd] + set _cgi(tmpperms) {} + set _cgi(sendmail) {} + } default { + set _cgi(tmpdir) [pwd] + catch {set _cgi(tmpdir) $env(TMP)} + catch {set _cgi(tmpdir) $env(TEMP)} + set _cgi(tmpperms) {} + set _cgi(sendmail) {} + } +} + +# regexp for matching attr=val +set _cgi(attr,regexp) "^(\[^=]*)=(\[^\"].*)" + +package provide cgi @CGI_VERSION_FULL@ diff --git a/web/src/cgi.tcl-1.10/cgi.tcl.man b/web/src/cgi.tcl-1.10/cgi.tcl.man new file mode 100644 index 00000000..c121800b --- /dev/null +++ b/web/src/cgi.tcl-1.10/cgi.tcl.man @@ -0,0 +1,36 @@ +.TH CGI.TCL 3 "12 December 1995" +.SH NAME +cgi.tcl \- procedures for CGI scripting in Tcl +.SH DESCRIPTION + +These routines implement the code described in the paper "Writing CGI +scripts in Tcl" which appeared in the Tcl '96 conference. + +This man page is really just a placeholder. See the README for more +info. + +.SH SYNOPSIS +.nf + +source cgi.tcl + +more to come... + +.fi +No attempt is made to explain all aspects of the code. The paper is +the right way to get started. After that, read the code \- the code +really is quite straightforward. Feel free to make changes to it. +Experiment. No claims of completeness are made. (In fact, I can +assure you that there are missing pieces - there are things in CGI +that I find utterly useless so I didn't bother to support them.) + +More to come... + +.SH SEE ALSO +.SH AUTHOR +Don Libes, libes@nist.gov, National Institute of Standards and Technology +.SH ACKNOWLEDGEMENTS +Design and implementation of the this software was paid for by the +U.S. government and is therefore in the public domain. However the +author and NIST would like credit if this program and documentation or +portions of them are used. diff --git a/web/src/cgi.tcl-1.10/configure b/web/src/cgi.tcl-1.10/configure new file mode 100755 index 00000000..1c167432 --- /dev/null +++ b/web/src/cgi.tcl-1.10/configure @@ -0,0 +1,2291 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.59. +# +# Copyright (C) 2003 Free Software Foundation, Inc. +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +exec 6>&1 + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_config_libobj_dir=. +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Maximum number of lines to put in a shell here document. +# This variable seems obsolete. It should probably be removed, and +# only ac_max_sed_lines should be used. +: ${ac_max_here_lines=38} + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= + +ac_unique_file="Makefile.in" +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CGI_MAJOR_VERSION CGI_MINOR_VERSION CGI_MICRO_VERSION CGI_VERSION_FULL CGI_VERSION CGI_LIB_FILE CGI_LIB_FILES CGI_TCL_EXECUTABLE LIBOBJS LTLIBOBJS' +ac_subst_files='' + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +ac_prev= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_option in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + eval "enable_$ac_feature=no" ;; + + -enable-* | --enable-*) + ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid feature name: $ac_feature" >&2 + { (exit 1); exit 1; }; } + ac_feature=`echo $ac_feature | sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; + esac + eval "enable_$ac_feature='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package| sed 's/-/_/g'` + case $ac_option in + *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; + *) ac_optarg=yes ;; + esac + eval "with_$ac_package='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid package name: $ac_package" >&2 + { (exit 1); exit 1; }; } + ac_package=`echo $ac_package | sed 's/-/_/g'` + eval "with_$ac_package=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) { echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` + eval "$ac_envvar='$ac_optarg'" + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + { echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } +fi + +# Be sure to have absolute paths. +for ac_var in exec_prefix prefix +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* | NONE | '' ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done + +# Be sure to have absolute paths. +for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ + localstatedir libdir includedir oldincludedir infodir mandir +do + eval ac_val=$`echo $ac_var` + case $ac_val in + [\\/$]* | ?:[\\/]* ) ;; + *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; };; + esac +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_confdir=`(dirname "$0") 2>/dev/null || +$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$0" : 'X\(//\)[^/]' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$0" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 + { (exit 1); exit 1; }; } + else + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } + fi +fi +(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || + { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 + { (exit 1); exit 1; }; } +srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` +ac_env_build_alias_set=${build_alias+set} +ac_env_build_alias_value=$build_alias +ac_cv_env_build_alias_set=${build_alias+set} +ac_cv_env_build_alias_value=$build_alias +ac_env_host_alias_set=${host_alias+set} +ac_env_host_alias_value=$host_alias +ac_cv_env_host_alias_set=${host_alias+set} +ac_cv_env_host_alias_value=$host_alias +ac_env_target_alias_set=${target_alias+set} +ac_env_target_alias_value=$target_alias +ac_cv_env_target_alias_set=${target_alias+set} +ac_cv_env_target_alias_value=$target_alias + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +_ACEOF + + cat <<_ACEOF +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data [PREFIX/share] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --infodir=DIR info documentation [PREFIX/info] + --mandir=DIR man documentation [PREFIX/man] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +_ACEOF +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + ac_popdir=`pwd` + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d $ac_dir || continue + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + cd $ac_dir + # Check for guested configure; otherwise get Cygnus style configure. + if test -f $ac_srcdir/configure.gnu; then + echo + $SHELL $ac_srcdir/configure.gnu --help=recursive + elif test -f $ac_srcdir/configure; then + echo + $SHELL $ac_srcdir/configure --help=recursive + elif test -f $ac_srcdir/configure.ac || + test -f $ac_srcdir/configure.in; then + echo + $ac_configure --help + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi + cd $ac_popdir + done +fi + +test -n "$ac_init_help" && exit 0 +if $ac_init_version; then + cat <<\_ACEOF + +Copyright (C) 2003 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit 0 +fi +exec 5>config.log +cat >&5 <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + $ $0 $@ + +_ACEOF +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +hostinfo = `(hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + echo "PATH: $as_dir" +done + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_sep= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 2) + ac_configure_args1="$ac_configure_args1 '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" + # Get rid of the leading space. + ac_sep=" " + ;; + esac + done +done +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Be sure not to use single quotes in there, as some shells, +# such as our DU 5.0 friend, will then `close' the trap. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +{ + (set) 2>&1 | + case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in + *ac_space=\ *) + sed -n \ + "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" + ;; + *) + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------- ## +## Output files. ## +## ------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=$`echo $ac_var` + echo "$ac_var='"'"'$ac_val'"'"'" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + sed "/^$/d" confdefs.h | sort + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core && + rm -rf conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status + ' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo >confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer explicitly selected file to automatically selected ones. +if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { echo "$as_me:$LINENO: loading cache $cache_file" >&5 +echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . $cache_file;; + *) . ./$cache_file;; + esac + fi +else + { echo "$as_me:$LINENO: creating cache $cache_file" >&5 +echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in `(set) 2>&1 | + sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val="\$ac_cv_env_${ac_var}_value" + eval ac_new_val="\$ac_env_${ac_var}_value" + case $ac_old_set,$ac_new_set in + set,) + { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 +echo "$as_me: former value: $ac_old_val" >&2;} + { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 +echo "$as_me: current value: $ac_new_val" >&2;} + ac_cache_corrupted=: + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) + ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + + + + + + + + + + + + + +CGI_MAJOR_VERSION=1 +CGI_MINOR_VERSION=10 +CGI_MICRO_VERSION=0 +CGI_VERSION=$CGI_MAJOR_VERSION.$CGI_MINOR_VERSION +CGI_VERSION_FULL=$CGI_VERSION.$CGI_MICRO_VERSION + +# If `configure' is invoked (in)directly via `make', ensure that it +# encounters no `make' conflicts. +# +unset MFLAGS MAKEFLAGS + +# this'll use a BSD compatible install or our included install-sh +ac_aux_dir= +for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do + if test -f $ac_dir/install-sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f $ac_dir/install.sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f $ac_dir/shtool; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5 +echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;} + { (exit 1); exit 1; }; } +fi +ac_config_guess="$SHELL $ac_aux_dir/config.guess" +ac_config_sub="$SHELL $ac_aux_dir/config.sub" +ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5 +echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6 +if test -z "$INSTALL"; then +if test "${ac_cv_path_install+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in + ./ | .// | /cC/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + done + done + ;; +esac +done + + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. We don't cache a + # path for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the path is relative. + INSTALL=$ac_install_sh + fi +fi +echo "$as_me:$LINENO: result: $INSTALL" >&5 +echo "${ECHO_T}$INSTALL" >&6 + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + + +# Find a usable Tcl executable so that we can run Tcl utilities +# For simplicity, assume Tcl is completely installed. +echo "$as_me:$LINENO: checking for usable Tcl executable" >&5 +echo $ECHO_N "checking for usable Tcl executable... $ECHO_C" >&6 +for i in \ + ${exec_prefix}/bin/tclsh \ + `ls -r ${exec_prefix}/bin/tclsh[8-9]* 2>/dev/null` \ + ${prefix}/bin/tclsh \ + `ls -r ${prefix}/bin/tclsh[8-9]* 2>/dev/null` \ + ${srcdir}/../tcl/unix/tclsh \ + `ls -dr ${srcdir}/../tcl[8-9]*/unix/tclsh 2>/dev/null` \ + /usr/local/bin/tclsh \ + /usr/bin/tclsh ; do + if test -x "$i" ; then + CGI_TCL_EXECUTABLE=$i + break + fi +done +if test "x$CGI_TCL_EXECUTABLE" = "x" ; then + { { echo "$as_me:$LINENO: error: no tcl executable found, cannot install" >&5 +echo "$as_me: error: no tcl executable found, cannot install" >&2;} + { (exit 1); exit 1; }; } +else + echo "$as_me:$LINENO: result: $CGI_TCL_EXECUTABLE" >&5 +echo "${ECHO_T}$CGI_TCL_EXECUTABLE" >&6 +fi + +# +# Set up makefile substitutions +# + + + + + + + + + ac_config_files="$ac_config_files Makefile cgi.tcl version" +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +{ + (set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n \ + "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" + ;; + esac; +} | + sed ' + t clear + : clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + : end' >>confcache +if diff $cache_file confcache >/dev/null 2>&1; then :; else + if test -w $cache_file; then + test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" + cat confcache >$cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/; +s/:*\${srcdir}:*/:/; +s/:*@srcdir@:*/:/; +s/^\([^=]*=[ ]*\):*/\1/; +s/:*$//; +s/^[^=]*=[ ]*$//; +}' +fi + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then we branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +cat >confdef2opt.sed <<\_ACEOF +t clear +: clear +s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g +t quote +s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g +t quote +d +: quote +s,[ `~#$^&*(){}\\|;'"<>?],\\&,g +s,\[,\\&,g +s,\],\\&,g +s,\$,$$,g +p +_ACEOF +# We use echo to avoid assuming a particular line-breaking character. +# The extra dot is to prevent the shell from consuming trailing +# line-breaks from the sub-command output. A line-break within +# single-quotes doesn't work because, if this script is created in a +# platform that uses two characters for line-breaks (e.g., DOS), tr +# would break. +ac_LF_and_DOT=`echo; echo .` +DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` +rm -f confdef2opt.sed + + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_i=`echo "$ac_i" | + sed 's/\$U\././;s/\.o$//;s/\.obj$//'` + # 2. Add them. + ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: ${CONFIG_STATUS=./config.status} +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false +SHELL=\${CONFIG_SHELL-$SHELL} +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi +DUALCASE=1; export DUALCASE # for MKS sh + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# Work around bugs in pre-3.0 UWIN ksh. +$as_unset ENV MAIL MAILPATH +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +for as_var in \ + LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ + LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ + LC_TELEPHONE LC_TIME +do + if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then + eval $as_var=C; export $as_var + else + $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conf$$.sh + echo "exit 0" >>conf$$.sh + chmod +x conf$$.sh + if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conf$$.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 +echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } + $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 +echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + # We could just check for DJGPP; but this test a) works b) is more generic + # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). + if test -f conf$$.exe; then + # Don't use ln at all; we don't have any links + as_ln_s='cp -p' + else + as_ln_s='ln -s' + fi +elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.file + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_executable_p="test -f" + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +# IFS +# We need space, tab and new line, in precisely that order. +as_nl=' +' +IFS=" $as_nl" + +# CDPATH. +$as_unset CDPATH + +exec 6>&1 + +# Open the log real soon, to keep \$[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. Logging --version etc. is OK. +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX +} >&5 +cat >&5 <<_CSEOF + +This file was extended by $as_me, which was +generated by GNU Autoconf 2.59. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +_CSEOF +echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 +echo >&5 +_ACEOF + +# Files that config.status was made for. +if test -n "$ac_config_files"; then + echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_headers"; then + echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_links"; then + echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS +fi + +if test -n "$ac_config_commands"; then + echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS +fi + +cat >>$CONFIG_STATUS <<\_ACEOF + +ac_cs_usage="\ +\`$as_me' instantiates files from templates according to the +current configuration. + +Usage: $0 [OPTIONS] [FILE]... + + -h, --help print this help, then exit + -V, --version print version number, then exit + -q, --quiet do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to <bug-autoconf@gnu.org>." +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.59, + with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2003 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." +srcdir=$srcdir +INSTALL="$INSTALL" +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If no file are specified by the user, then we need to provide default +# value. By we need to know if files were specified by the user. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "x$1" : 'x\([^=]*\)='` + ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` + ac_shift=: + ;; + -*) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + *) # This is not an option, so the user has probably given explicit + # arguments. + ac_option=$1 + ac_need_defaults=false;; + esac + + case $ac_option in + # Handling of the options. +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --vers* | -V ) + echo "$ac_cs_version"; exit 0 ;; + --he | --h) + # Conflict between --help and --header + { { echo "$as_me:$LINENO: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: ambiguous option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; };; + --help | --hel | -h ) + echo "$ac_cs_usage"; exit 0 ;; + --debug | --d* | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" + ac_need_defaults=false;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&5 +echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2;} + { (exit 1); exit 1; }; } ;; + + *) ac_config_targets="$ac_config_targets $1" ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +if \$ac_cs_recheck; then + echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion +fi + +_ACEOF + + + + + +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_config_target in $ac_config_targets +do + case "$ac_config_target" in + # Handling of arguments. + "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "cgi.tcl" ) CONFIG_FILES="$CONFIG_FILES cgi.tcl" ;; + "version" ) CONFIG_FILES="$CONFIG_FILES version" ;; + *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; + esac +done + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason to put it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Create a temporary directory, and hook for its removal unless debugging. +$debug || +{ + trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 +} + +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./confstat$$-$RANDOM + (umask 077 && mkdir $tmp) +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF + +# +# CONFIG_FILES section. +# + +# No need to generate the scripts if there are no CONFIG_FILES. +# This happens for instance when ./config.status config.h +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t +s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t +s,@INSTALL_DATA@,$INSTALL_DATA,;t t +s,@CGI_MAJOR_VERSION@,$CGI_MAJOR_VERSION,;t t +s,@CGI_MINOR_VERSION@,$CGI_MINOR_VERSION,;t t +s,@CGI_MICRO_VERSION@,$CGI_MICRO_VERSION,;t t +s,@CGI_VERSION_FULL@,$CGI_VERSION_FULL,;t t +s,@CGI_VERSION@,$CGI_VERSION,;t t +s,@CGI_LIB_FILE@,$CGI_LIB_FILE,;t t +s,@CGI_LIB_FILES@,$CGI_LIB_FILES,;t t +s,@CGI_TCL_EXECUTABLE@,$CGI_TCL_EXECUTABLE,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@LTLIBOBJS@,$LTLIBOBJS,;t t +CEOF + +_ACEOF + + cat >>$CONFIG_STATUS <<\_ACEOF + # Split the substitutions into bite-sized pieces for seds with + # small command number limits, like on Digital OSF/1 and HP-UX. + ac_max_sed_lines=48 + ac_sed_frag=1 # Number of current file. + ac_beg=1 # First line for current file. + ac_end=$ac_max_sed_lines # Line after last line for current file. + ac_more_lines=: + ac_sed_cmds= + while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + else + sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag + fi + if test ! -s $tmp/subs.frag; then + ac_more_lines=false + else + # The purpose of the label and of the branching condition is to + # speed up the sed processing (if there are no `@' at all, there + # is no need to browse any of the substitutions). + # These are the two extra sed commands mentioned above. + (echo ':t + /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" + else + ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" + fi + ac_sed_frag=`expr $ac_sed_frag + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_lines` + fi + done + if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat + fi +fi # test -n "$CONFIG_FILES" + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case $ac_file in + - | *:- | *:-:* ) # input from stdin + cat >$tmp/stdin + ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` + ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; + * ) ac_file_in=$ac_file.in ;; + esac + + # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. + ac_dir=`(dirname "$ac_file") 2>/dev/null || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + { if $as_mkdir_p; then + mkdir -p "$ac_dir" + else + as_dir="$ac_dir" + as_dirs= + while test ! -d "$as_dir"; do + as_dirs="$as_dir $as_dirs" + as_dir=`(dirname "$as_dir") 2>/dev/null || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| \ + . : '\(.\)' 2>/dev/null || +echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } + /^X\(\/\/\)[^/].*/{ s//\1/; q; } + /^X\(\/\/\)$/{ s//\1/; q; } + /^X\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + done + test ! -n "$as_dirs" || mkdir $as_dirs + fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 +echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} + { (exit 1); exit 1; }; }; } + + ac_builddir=. + +if test "$ac_dir" != .; then + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A "../" for each directory in $ac_dir_suffix. + ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` +else + ac_dir_suffix= ac_top_builddir= +fi + +case $srcdir in + .) # No --srcdir option. We are building in place. + ac_srcdir=. + if test -z "$ac_top_builddir"; then + ac_top_srcdir=. + else + ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` + fi ;; + [\\/]* | ?:[\\/]* ) # Absolute path. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir ;; + *) # Relative path. + ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_builddir$srcdir ;; +esac + +# Do not use `cd foo && pwd` to compute absolute paths, because +# the directories may not exist. +case `pwd` in +.) ac_abs_builddir="$ac_dir";; +*) + case "$ac_dir" in + .) ac_abs_builddir=`pwd`;; + [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; + *) ac_abs_builddir=`pwd`/"$ac_dir";; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_builddir=${ac_top_builddir}.;; +*) + case ${ac_top_builddir}. in + .) ac_abs_top_builddir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; + *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_srcdir=$ac_srcdir;; +*) + case $ac_srcdir in + .) ac_abs_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; + *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; + esac;; +esac +case $ac_abs_builddir in +.) ac_abs_top_srcdir=$ac_top_srcdir;; +*) + case $ac_top_srcdir in + .) ac_abs_top_srcdir=$ac_abs_builddir;; + [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; + *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; + esac;; +esac + + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_builddir$INSTALL ;; + esac + + if test x"$ac_file" != x-; then + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + rm -f "$ac_file" + fi + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + if test x"$ac_file" = x-; then + configure_input= + else + configure_input="$ac_file. " + fi + configure_input=$configure_input"Generated from `echo $ac_file_in | + sed 's,.*/,,'` by configure." + + # First look for the input files in the build tree, otherwise in the + # src tree. + ac_file_inputs=`IFS=: + for f in $ac_file_in; do + case $f in + -) echo $tmp/stdin ;; + [\\/$]*) + # Absolute (can't be DOS-style, as IFS=:) + test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + echo "$f";; + *) # Relative + if test -f "$f"; then + # Build tree + echo "$f" + elif test -f "$srcdir/$f"; then + # Source tree + echo "$srcdir/$f" + else + # /dev/null tree + { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 +echo "$as_me: error: cannot find input file: $f" >&2;} + { (exit 1); exit 1; }; } + fi;; + esac + done` || { (exit 1); exit 1; } +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + sed "$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s,@configure_input@,$configure_input,;t t +s,@srcdir@,$ac_srcdir,;t t +s,@abs_srcdir@,$ac_abs_srcdir,;t t +s,@top_srcdir@,$ac_top_srcdir,;t t +s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t +s,@builddir@,$ac_builddir,;t t +s,@abs_builddir@,$ac_abs_builddir,;t t +s,@top_builddir@,$ac_top_builddir,;t t +s,@abs_top_builddir@,$ac_abs_top_builddir,;t t +s,@INSTALL@,$ac_INSTALL,;t t +" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out + rm -f $tmp/stdin + if test x"$ac_file" != x-; then + mv $tmp/out $ac_file + else + cat $tmp/out + rm -f $tmp/out + fi + +done +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF + +{ (exit 0); exit 0; } +_ACEOF +chmod +x $CONFIG_STATUS +ac_clean_files=$ac_clean_files_save + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || { (exit 1); exit 1; } +fi + diff --git a/web/src/cgi.tcl-1.10/configure.in b/web/src/cgi.tcl-1.10/configure.in new file mode 100644 index 00000000..7b7f6880 --- /dev/null +++ b/web/src/cgi.tcl-1.10/configure.in @@ -0,0 +1,52 @@ +# Process this file with autoconf to produce a configure script. + +AC_INIT(Makefile.in) +CGI_MAJOR_VERSION=1 +CGI_MINOR_VERSION=10 +CGI_MICRO_VERSION=0 +CGI_VERSION=$CGI_MAJOR_VERSION.$CGI_MINOR_VERSION +CGI_VERSION_FULL=$CGI_VERSION.$CGI_MICRO_VERSION + +# If `configure' is invoked (in)directly via `make', ensure that it +# encounters no `make' conflicts. +# +unset MFLAGS MAKEFLAGS + +# this'll use a BSD compatible install or our included install-sh +AC_PROG_INSTALL + +# Find a usable Tcl executable so that we can run Tcl utilities +# For simplicity, assume Tcl is completely installed. +AC_MSG_CHECKING([for usable Tcl executable]) +for i in \ + ${exec_prefix}/bin/tclsh \ + `ls -r ${exec_prefix}/bin/tclsh[[8-9]]* 2>/dev/null` \ + ${prefix}/bin/tclsh \ + `ls -r ${prefix}/bin/tclsh[[8-9]]* 2>/dev/null` \ + ${srcdir}/../tcl/unix/tclsh \ + `ls -dr ${srcdir}/../tcl[[8-9]]*/unix/tclsh 2>/dev/null` \ + /usr/local/bin/tclsh \ + /usr/bin/tclsh ; do + if test -x "$i" ; then + CGI_TCL_EXECUTABLE=$i + break + fi +done +if test "x$CGI_TCL_EXECUTABLE" = "x" ; then + AC_MSG_ERROR([no tcl executable found, cannot install]) +else + AC_MSG_RESULT($CGI_TCL_EXECUTABLE) +fi + +# +# Set up makefile substitutions +# +AC_SUBST(CGI_MAJOR_VERSION) +AC_SUBST(CGI_MINOR_VERSION) +AC_SUBST(CGI_MICRO_VERSION) +AC_SUBST(CGI_VERSION_FULL) +AC_SUBST(CGI_VERSION) +AC_SUBST(CGI_LIB_FILE) +AC_SUBST(CGI_LIB_FILES) +AC_SUBST(CGI_TCL_EXECUTABLE) +AC_OUTPUT(Makefile cgi.tcl version) diff --git a/web/src/cgi.tcl-1.10/doc/ref.txt b/web/src/cgi.tcl-1.10/doc/ref.txt new file mode 100644 index 00000000..79ddd721 --- /dev/null +++ b/web/src/cgi.tcl-1.10/doc/ref.txt @@ -0,0 +1,1651 @@ +cgi.tcl - A Reference Manual (Draft) +by Don Libes + +This document contains technical notes on using cgi.tcl. This +document is a draft and has not been officially reviewed. + +This document assumes that you have read the Tcl '96 paper "CGI +Scripting in Tcl". That document will give you the feel for what this +code is all about. In contrast, this document provides the details. + +This document assumes you know HTML. I'm not going to explain what +particular tags do or how to use them effectively, except as necessary +to understand the document. + +Some of the commands may not work with all browsers. For example, the +cgi_center command is generally understood only by some Netscape +browsers because it produces <center></center> tags which are not +commonly supported. You'll have to use your judgement. Remember: +Just because a command exists to produce the HTML doesn't mean your +browser will do anything meaningful with it. In that sense, using +this code is no different than handcoding HTML. + +************************************************** +A NOTE ABOUT PROCEDURE NAMES +************************************************** + +All procedures are named cgi_XXX. You can also call them without the +cgi_ prefix. Using the cgi_XXX form is no big deal for rarely used +procedures, but the aliases are particularly convenient for things +like hr and br. Aliases are suppressed if procedures exist by those +names already. (Thus, cgi_eval cannot be invoked as "eval"!) +Similarly, you can overwrite the aliases with impunity. Internally, +references are only made to the cgi_ names. + +I'm still thinking about this. If you have strong feelings about it, +let me know. + +************************************************** +SECURITY +************************************************** + +I frequently see statements saying that Tcl (and other interpretive +languages, for that matter) are insecure and should not be used for +writing CGI. + +I disagree. It is possible to use Tcl securely and it really isn't +very hard. The key, of course, is to not blindly evaluate user input. +There really isn't much reason to. For instance, this library itself +is pretty big and does lots of things, but nothing in it evaluates +user input. (It does do a lot of evaluation of *programmer* input, +but that's quite acceptable.) + +The two classes of commands you should pay close attention to are +commands that do eval operations and commands that invoke external +programs. + +************************************************** +GENERAL NOTES ABOUT PARAMETERS +************************************************** + +** There are several basic styles of parameter passing. + +-- Container commands (e.g., <body></body>, <div></div>, etc.) + +The last argument is typically a block of code. Other arguments +become attributes. For example: + + cgi_body bgcolor=red background=white { + h4 "hello" + } + +produces: + + <body bgcolor="red" background="white"> + <h4>hello</h4> + </body> + +-- Commands with required arguments + +Some commands have required arguments. Required arguments which are +relatively long, are passed *after* all others. For example: + + cgi_h4 align=left "Foo's Bar & Grill" + +Another example: + + cgi_body bgcolor=red background=white { + cgi_h4 "Foo's Bar & Grill" + } + +Commands with relatively short arguments have the short arguments +passed *before* all others. This avoids many redundant keywords. In +the following example, the "img=" is omitted because it is already +implied by the command. The "alt=" is not optional (although the +entire argument is). + + cgi_img foo.gif "alt=Foo's Bar & Grill" + +Note the quotes around the alt argument. This is only necessary if +the argument has whitespace in it - a consequence of Tcl's normal +scanning rules. The resulting HTML automatically includes quotes +around the value attribute. (See Case-sensitivity.) + +** Case-sensitivity and Quotes and Whitespace + +Attribute names are case sensitive. Use lowercase names for "normal" +handling. For example, values for attributes such as "url" and +"value" are quoted and encoded. Use uppercase names to suppress the +usual processing. (For example, you might want to test how a browser +responds to incorrect HTML.) + +Consider: + + cgi_body bgcolor=#123456 { + p [cgi_img foo.gif "alt=Foo's Bar & Grill"] + } + +This is translated to + + <body bgcolor="#123456"> + <p><img src="foo.gif" alt="Foo's Bar & Grill"></p> + </body> + +Notice how the ampersand in the alt value has been encoded. Also +notice how quotes have been added to the values of bgcolor, url, and +alt. Thus you no longer have to add quotes all over the place (or +remember when you need to). + +Embedded whitespace is protected by quoting in the usual Tcl fashion +rather than typical HTML fashion. + +So instead of: + img foo.gif alt="foo bar" +do this: + img foo.gif "alt=foo bar" +which will return HTML that is properly quoted: + <img src="foo.gif" alt="foo bar"> + +-- Name-value commands + +Many commands produce tags that use "name" and "value" attributes. +Because these attributes are almost always used in such commands, the +first argument is always of the form name=value so the literal "name" +and "value" can be omitted. For example: + + cgi_text color=Red size=5 + +produces: + + <input name="color" value="Red" size=5> + +Reasonable defaults exist. For example, if you don't need the value +of a submit button (but the user still needs to see it appear as the +label), omit the name: + + cgi_submit_button =Execute + +If no "=" is present, the string is assumed to be the "name" +attribute. For example: + + cgi_checkbox Vegies + +produces a checkbox associated with the variable named "Vegies". +(With no specified value, it will be set to "on" if checked.) + +Most of the commands have reasonable defaults. For example, to +quickly script a submit button, the following suffices: + + cgi_submit_button + +Certain constructions make no sense and are therefore disallowed. For +example, a submit button with a name but no value makes no sense, so +cgi_submit_button doesn't allow it. (In other words, if you provide +an argument, it has to have "=" in it.) + +************************************************** +JAVASCRIPT ARGUMENTS +************************************************** + +JavaScript event attributes such as onClick are handled just like any +other attributes in terms of quoting and case sensitivity. Because +there are so many attributes on so many tags, they are not documented +explicitly in this manual. However, they are all supported. Here is +an example: + + cgi_text age=18 onChange=MinimumAge(this.form.age) + +************************************************** +PROCEDURES TO ASSIST IN DEBUGGING +************************************************** + +** User-id differences + +You can interactively run and debug CGI scripts by simply running them +from the shell, or a Tcl or C debugger. (For convenience, I use +Expect instead of tclsh just so that I get the debugger.) In fact, +I've never had to resort to the C debugger. However, simply watching +the raw output from a shell is very handy. This catches the really +basic errors such as incorrect protections, incorrect #! line, etc. +Once your script is actually executing, you can rely on cgi_eval (see +below). + +cgi_uid_check user + +Typically, a CGI script is intended to run from a particular uid, such +as "nobody". If you run such scripts interactively, you can end up +with conflicts. For example, if the script creates files, files can +accidentally end up being owned by you. + +cgi_uid_check is a convenient mechanism to warn against this problem. +Simply call cgi_uid_check in your script. The argument is the uid +under which the script should be running. If the given uid does +not match the actual uid, cgi_uid_check will generate an error. + +** Trapping error messages + +cgi_eval + +cgi_eval is the primary error catching/reporting mechanism. Execute +commands from cgi_eval so that errors can be caught and reported in a +nice way. By default, errors are emailed back to the administrator. +"cgi_debug -on" makes errors be immediately viewable in the browser. + +If an error is caught when debugging is enabled, the diagnostic is +anchored with #cgierror. This is useful in scripts that produce +voluminous output. + +cgi_error_occurred + +cgi_error_occurred returns 1 if an error occurred and was caught by +cgi_eval. This separate function simplifies exit handling - for +example, rather than always checking the return value of cgi_eval, an +app can just test this from a redefined exit. + +cgi_admin_mail_addr addr + +cgi_admin_mail_addr sets the administrator's email address. +Diagnostics are sent via email if a problem is encountered with the +script and debugging is not enabled. + +cgi_name name + +cgi_name defines a name for the service. If called with no arguments, +the name is returned. The name is currently used in the following +places: + + If email is sent, it comes from [cgi_name]. + If errors are emailed, the subject is "[cgi_name]: CGI problem" + +** Generating debugging output and other commands + +cgi_debug args + +cgi_debug provides rudimentary support for generating debugging +messages. Here are some example calls: + +cgi_debug cmd + If debugging is on, the command is evaluated. For example: + + cgi_debug { + h2 "completed initialization" + } + or + cgi_debug {h2 "completed initialization"} + + Note this is more than simply calling h2. Context is rewound + or forwarded to get to a place where this is safe. (And + conversely, this call can suppress things such as header + elements that haven't been processed yet.) The flag + "-noprint" suppresses this manipulation - this is useful for + early code that causes no printing. + + The -- flag causes the next argument to treated as a command + even if it looks like another flag. +cgi_debug -on + Enables debugging messages. This includes debugging messages + generated by explicit calls to cgi_debug as well as implicit + diagnostics, for example, that report on form input. +cgi_debug -temp text + Enable debugging for this one line. +cgi_debug -off + Disable debugging. + +cgi_debug always returns the old setting ("-on" or "-off"). The +initial value is -off. + + +** Printing arrays + +cgi_parray arrayname + +cgi_parray prints out the elements of a Tcl array. cgi_parray is just +like Tcl's parray except that its output is appropriately formatted +for a browser. + +************************************************** +BASIC STRUCTURE OF A CGI SCRIPT +************************************************** + +Typically, the basic structure of most CGI scripts is: + + package require cgi + + cgi_eval { + cgi_http_head {cmds} + cgi_html { + cgi_head {cmds} + cgi_body {cmds} + } + } + +Much of this can be omitted, however. In fact, a typical script looks +more like this: + + package require cgi + + cgi_eval { + cgi_title "title" + cgi_body { + cmds + } + } + +(If you're not using the Tcl package support, replace the 'package +require' command with a 'source' command of the specific file +containing the cgi.tcl source.) + +(The "...." in the examples above should be replaced by the true path +to the cgi.tcl file.) + +I'll now go through each of these in more detail as well as some other +possibilities for the overall structure. + +************************************************** +HTTP HEADERS +************************************************** + +cgi_http_head cmds + +CGI scripts must produce various headers to explain how the remainder +of the output is to be interpreted. No other output may preceed this! + +With no argument, an HTML content type is produced if the script is +running in the CGI environment. This means that most people need not +bother calling cgi_http_head. However, if you want to see the HTTP +headers and you are not running in the CGI environment, you should +call cgi_http_head explicitly. (Alternatively, you can make it appear +that you are in the CGI environment by defining the environment +variable REQUEST_METHOD.) + +The remaining commands in this section may be used in cgi_http_head. +Most should be intuitively obvious and thus need no explanation. + +cgi_content_type type + Generates a "Content-type:" header. + +With no argument, cgi_content_type generates a declaration for HTML. +If specified, the 'type' argument should be the full MIME-style +type/subtype declaration. Any MIME-style parameters should be +included in the type argument. + +cgi_redirect location + Generates a redirect header (Status:/Location:/URI:) +cgi_target + Generates a "Window-target:" header. +cgi_refresh seconds url + Generates a "Refresh:" header. The url argument is optional. +cgi_pragma pragma + Generates a "Pragma:" header. +cgi_status number string + Generates a "Status:" header. + +** Cookies + +cgi_cookie_set name=val args + Define a cookie with given name, value, and other arguments. + Cookie values are automatically encoded to protect odd characters. + A couple expirations are predefined (with intuitive meaning): + expires=never + expires=now + expires=...actual date... + + Here are some examples: + cgi_cookie_set user=don domain=nist.gov expires=never + cgi_cookie_set user=don expires=now secure + +cgi_export_cookie name args + Export the named Tcl variable as a cookie. Other arguments are + processed as with cgi_cookie_set. + +Cookies may be read only after calling cgi_input. The following +routines read cookie names or specific cookies. + +cgi_cookie_list + Returns the list of all cookies supplied by the server. + +cgi_cookie_get name + Returns the value of the named cookie. If multiple values exists + the most specific path mapping is used. + + If the "-all" flag is used (before the cookie name), a list is + returned containing all cookie values for the given name. The + list is ordered most-specific (path mapping) to least. I.e., + the first value on the list is the same one returned by + calling cgi_cookie get without a flag. + +cgi_import_cookie name + Define a Tcl variable with the value of the cookie of the same + name. For example, the following command retrieves the cookie + named "Password" and stores it in the Tcl variable "Password". + + cgi_import_cookie Password + + +************************************************** +GENERATING HTML +************************************************** + +cgi_html + +<html></html> tags can be generated using cgi_html. An argument to +cgi_html is evaluated to produce the actual HTML code. + +In practice, it is not necessary to use cgi_html. CGI.tcl will +automatically generate the tags when appropriate. (Oddly, modern HTML +specs don't require it and most if not all browsers never cared +anyway.) + +cgi_doctype + +cgi_doctype is a user-defined procedure that produces a SGML DOCTYPE +declaration. If it exists, cgi_doctype is automatically invoked at +the beginning of cgi_html. (This library does not automatically create +DOCTYPE declarations since the library is not restricted to generating +SGML for any single DTD. Realistically, DOCTYPEs are pointless for +HTML generation since web browsers don't require DOCTYPE declarations. +However, if you are creating pages for some other purpose that +requires such a declaration, use cgi_doctype.) + +cgi_head + +<head></head> tags can be generated using cgi_head. An argument to +cgi_head is evaluated to produce the actual headers. + +In practice, it is not necessary to use cgi_head. CGI.tcl will +automatically generate the tags when appropriate. (Oddly, modern HTML +specs don't require it and most if not all browsers never cared +anyway. So for example: + + cgi_head { + cgi_title "my page" + } + +is equivalent to: + + cgi_title "my page" + +Note that cgi_title will be called automatically if you omit +cgi_title, cgi_head, or call cgi_head with no arguments. + +cgi_title title + +cgi_title defines the title of a page. It is called from within a +<head></head> pair. If not called from within cgi_head, it implicitly +forces it to occur. + +cgi_title always returns the title. With no argument, cgi_title +returns the old title without changing it. + +cgi_http_equiv + +cgi_http_equiv is equivalent to cgi_http_head but from within +cgi_head. This procedure is defined for completeness - there is no +reason to use it. In fact, it doesn't allow all cgi_http_head +declarations, so it should be avoided. + +cgi_meta + +cgi_meta generates a <meta> tag. You can do whatever you want with +these. (Read some an HTML document for more info.) For example: + + meta name=author {content="Don Libes"} + +cgi_script cmd + +cgi_script evaluates its arguments inside of <script></script> tags. +This is appropriate for putting in client-side scripting. Optional +arguments are passed as attributes to the <script> tag. + +Note that the cmd argument is a Tcl command, not a command in the +other scripting language. So if all you want to do is print out some +script, use cgi_puts: + + cgi_script { + cgi_puts { + some scripting stuff + in whatever weird funky + language you want + } +} + +cgi_javascript cmd + +cgi_javascript is a version of cgi_script specialized for javascript. +At present, all it does is add the comment hacks so that the +javascript can't be seen by old browsers. + +cgi_noscript cmd + +cgi_noscript evaluates its argument to generate code for browsers that +do not understand cgi_script or its variants. + +cgi_body + +<body></body> tags are generated using cgi_body. An argument to +cgi_body is evaluated to produce the actual body. + +Executing "return" from within cgi_body causes cgi_body to return. +This is useful if more code follows the cgi_body within the cgi_eval. +Compare to cgi_exit (see elsewhere). + +cgi_body_args + +Arguments to cgi_body_args are made available to cgi_body as if they +had been specified in the call to cgi_body. This provides a +convenient way for using the same colors, backgrounds, etc, in a set +of pages. + +cgi_exit + +cgi_exit provides a fast way of cleanly exiting a CGI script without +having to manually unwind procedures. In particular, cgi_exit forces +closure of all open tags. It then calls exit. This is useful if you +want to exit from a CGI script at any point and still have the HTML be +correct. + +** Frames + +cgi_frameset cmd + +Instead of cgi_body, you can call cgi_frameset to create framed +documents. This produces <frameset></frameset> tags with the content +filled by evaluation of cmd. Optional arguments are passed on as +attributes. + +cgi_frame name=url + +cgi_frame defines a frame with the given name and url. The argument +handling is the same as for other name-value commands (even though the +value here is a url). The url is automatically double-quoted. Other +optional arguments are passed on as attributes. + +cgi_noframes cmd + +cgi_noframes produces <noframes></noframes> tags with the content +filled evaluation of cmd. Optional arguments are passed on as +attributes. + +************************************************** +CONTAINER SUPPORT +************************************************** + +cgi_division + +cgi_division evaluates its last argument, grouping it together. This +is useful for acting on a group of paragraphs, such as for alignment +purposes. + +cgi_center + +cgi_center is similar to "cgi_division align=center". + +************************************************** +SINGLE PARAGRAPH SUPPORT +************************************************** + +Everything in this section generates a single paragraph or line break. +Most of these take a string as the last argument which is +appropriately formatted. Any other arguments are used as tag +attributes. + +cgi_p +cgi_address +cgi_blockquote +cgi_h1 through h7 + +Most of these procedures should be intuitive. They all take a string +and display it in the appropriate way. For example, a level 2 +heading: + + h2 "Paragraph Support" + +Here's a paragraph with some formatting (see next section for more +info): + + p "I [bold love] Tcl but hate [blink "blinking text"]" + +Note that some of these generate tags that are not supported by all +browsers. See the format-tour.cgi script to see these in use. + +cgi_br + +cgi_br causes a paragraph break to be printed. Additional arguments +are passed on as attributes. + +To embed a paragraph break (rather than printing it), use cgi_nl. In +the following example, it is much more convenient to call cgi_br than +cgi_nl: + + radio_button "version=1" + br + radio_button "version=2" + +See cgi_nl for more info. + +************************************************** +TEXT SUPPORT +************************************************** + +The following procedures take a string and return an appropriately +formatted version. The string is always the last argument. Any other +arguments are used as tag attributes. + +cgi_bold +cgi_italic +cgi_underline +cgi_strikeout +cgi_subscript +cgi_superscript +cgi_typewriter +cgi_blink +cgi_emphasis +cgi_strong +cgi_cite +cgi_sample +cgi_keyboard +cgi_variable +cgi_definition +cgi_big +cgi_small +cgi_font + + p "I [bold love] Tcl but hate [blink "blinking text"]" + +Note that some of these generate tags that are not supported by all +browsers. See the format-tour.cgi script to see these in use. + +cgi_basefont + +cgi_basefont defines the base font. + +************************************************** +SPECIAL CHARACTERS OR CHARACTER SEQUENCES +************************************************** + +The following procedures produce characters such that when interpreted +by a browser returns the indicated character. + + Returns +cgi_lt < +cgi_gt > +cgi_amp & +cgi_quote " +cgi_enspace en space +cgi_emspace em space +cgi_nbspace nonbreaking space +cgi_tm registered trademark +cgi_copyright copyright +cgi_isochar n ISO character #n + +cgi_nl + +cgi_nl returns a paragraph break string suitable for embedding in a +string just as you would embed a newline in a Tcl string via \n. + +To print a paragraph break rather than returning it, use cgi_br. In +the following example, it is much more convenient to call cgi_nl than +than cgi_br: + + h2 "This appears[nl]on two lines." + +See cgi_br for more info. + +cgi_breakable + +cgi_breakable indicates a place in a word at which the browser can +break a string across two lines. + +cgi_unbreakable cmd + +cgi_unbreakable evaluates a cmd in such a way that the output will not +be broken across lines by the browser just because the screen width is +exceeded. Instead a horizontal scrollbar will appear so that the +browser can be manually scrolled to see the long line. +n +cgi_unbreakable_string string + +cgi_unbreakable_string returns its arguments so that it will not be +broken across lines by the browser just because the screen width is +exceeded. Instead a horizontal scrollbar will appear so that the +browser can be manually scrolled to see the long line. + +Notes: + +- It is my assumption that cgi_unbreakable will be much more commonly +used than the _string version, hence the choice of names. Feel free +to let me know what I'm wrong. + +- I have seen browsers handle unbreakables incorrectly, particularly +in interaction with other features. If you can't get your +unbreakables to behave correctly, consider alternative layouts or +alternative HTML. For example, unbreakable table data should be done +using "table_data nowrap". I have no idea why but it works whereas +unbreakable causes the table rows to overlap. Clearly, this is a +browser bug. + +************************************************** +FORMS +************************************************** + +cgi_form action args cmd + +cgi_form defines a form. The form is populated by executing the +command (last argument of cgi_form). action defines the url to +process the form. Any other arguments are passed as attributes. +A typical call looks like this: + + cgi_form response { + .... + } + +Here "response" names the URL to process the form. If the URL does +not begin with a protocol name (such as "http:"), a common root is +prepended and ".cgi" is appended. This can be changed by redefining +the procedure cgi_cgi. + +cgi_root + +cgi_root defines the common root used by cgi_form (see above). +For example: + + cgi_root "http://www.nist.gov/cgi-bin/cgi.tcl-examples" + +With one argument, cgi_root returns the new root. With no arguments, +cgi_root returns the old root. + +cgi_suffix + +cgi_suffix defines the common suffix used by cgi_cgi and anything that +uses it such as cgi_form. The default suffix is ".cgi". + +cgi_cgi +cgi_cgi_set + +cgi_cgi controls exactly how cgi_form creates URLs from its action +argument. By default, cgi_cgi takes an argument, prepends [cgi_root] +and appends [cgi_suffix]. The suffix can be overridden by using the +-suffix flag and an argument to be used instead of [cgi_suffix]. + +Any additional arguments are joined together in the style required for +a GET style request. These arguments should be preformatted using +cgi_cgi_set to guarantee proper encoding. For example: + + cgi_cgi myscript \ + [cgi_cgi_set owner "Don"] \ + [cgi_cgi_set color "black & white"] + +generates: ....?owner=Don&color=black+%26+white + +cgi_isindex + +cgi_isindex generates an <isindex> tag. Optional arguments are passed +on as attributes. In the processing CGI script, the value of the +isindex query is found in the "anonymous" variable. + +cgi_relationship rel url + +cgi_relationship expresses a relationship between this document and +another. For example, the following says that the url named by +homepage is the home document of the current document. + + cgi_relationship home $homepage + +Optional arguments are passed on as additional attributes. Here's an +example that references an external style sheet that is a CSS type +(cascading style sheet). + + cgi_relationship stylesheet basic.css type=text/css + + +************************************************** +INPUT +************************************************** + +cgi_input + +CGI input means "cookies, files, and get/post data". cgi_input reads +in all input, decodes it, and makes it available to a variety of other +routines. + +For debugging, cgi_input can be given arguments to fake input. This +allows you to run your cgi_script interactively or under a debugger +(either Tcl or C debugger). Provide GET/POST data as the first +argument. Provide cookie data as the second argument. The arguments +should be encoded (see cgi_cgi_set). For example: + + cgi_input "name=libes&old=foo&new1=bar&new2=hello" + +This is convenient because when you run into a misbehaving CGI script, +the first thing it does is tell you the input in exactly this format. +Simply cut and paste it into your program and you can then +interactively debug it without using the real form or the CGI server. + +If cgi_input is invoked from the CGI environment, the fake inputs are +ignored. (If you want to force fake inputs in the CGI environment, +unset env(REQUEST_METHOD). + +Forms encoded as multipart/form-data are usually used to handle file +input. Since file data usually implies a large amount of data, the +data is saved to /tmp/CGIdbg.[pid] if debugging is enabled. This file +can be fed back to cgi_input by providing the filename as the first +argument of cgi_input. In addition, env(CONTENT_TYPE) must be set to +the appropriate content type. This can found in env(CONTENT_TYPE). +Removal of the debugging file is the responsibility of the script or +the script programmer. (Typically, I examine the file after my CGI +script is over and then delete them by hand.) + +Execs before cgi_input reads POST data should have standard input +redirected ("< /dev/null" for instance) so that the exec'd process +doesn't inherit the CGI script's standard input. + +** Form elements that generate lists + +Variable names should only end with "List" if they correspond to form +elements which generate multiple values (some but not all uses of +select, checkbox, etc). List variables will be given Tcl-style list +values. + +If cgi_input encounters multiple values for variables that do not end +with List, it will provide the values in a Tcl-style list. However, +this leaves an ambiguity in the case of a single value that "looks" +like a list, such as "a b". Although a form author can usually "know" +whether a string is a list or not, it is simpler to stick to the +convention stated earlier. + +Here are examples: + + # pull-down menu + cgi_select Foo { + cgi_option "a" + cgi_option "a b" + } + + # scrolled list, allow multiple selections + cgi_select FooList multiple { + cgi_option "a" + cgi_option "a b" + } + +** Getting at the input + +Input is made available in two ways: variables, files, and cookies. + +-- Variables and Cookies + +cgi_import_list + +cgi_import_list returns a list of variable names supplied as input to +the script. + +cgi_cookie_list + +cgi_cookie_list returns a list of cookie names supplied to the script. + +cgi_import name + +cgi_import retrieves the value of the named variable and places it in +a Tcl variable of the same name. The value is also returned as the +return value. + +cgi_import_as name tclvar + +cgi_import_as is similar to cgi_import but the value is assigned to +the Tcl variable named by the second argument. + +cgi_import_cookie name + +cgi_import is similar to cgi_import, however if the cgi variable does +not exist, the value is fetched from the cookie by that name. (This +allows the user to override a cookie if the form allows it.) + +cgi_import_cookie_as name tclvar + +cgi_import_cookie_as is similar to cgi_import_cookie but the value is +assigned to the Tcl variable named by the second argument. + +cgi_cookie_get name + +cgi_cookie_get returns the value of the named cookie. + +-- Files + +cgi_import_file -server name +cgi_import_file -client name +cgi_import_file -type name + +cgi_import_file returns information about an uploaded file. "name" is +the string from the original form. The Content-type is returned via +-type. (This may be empty or even undefined in which case +cgi_import_file should be caught.) + +Uploaded files are saved on the CGI server. To avoid collisions with +other file upload instances, files are not stored in their original +names. The name of the file as it is stored on the CGI server is +retrieved using the "-server" flag. The original name of the file as +it was stored on the user's host is retrieved using the "-client" +flag. + +Uploaded files are the responsibility of the CGI programmer. In +particular, if you do not delete them, they will remain until /tmp is +cleaned up in some other way. + +If the user does not enter a filename, an empty file will be delivered +with a null remote filename. + +cgi_file_limit files chars + +cgi_file_limit establishes limits on the number of files and their +size. This is provided to prevent denial of service attacks. If the +limit is exceeded, an error is raised from within cgi_input. + +Note that when the limit is exceeded, cgi_input fails immediately. So +if you just want to check file sizes that are not security related - +for example, you just want to accept gifs under 10K - it's better to +accept the gifs and then check the size manually (i.e., [file size +...]. That way, cgi_input will completely read all the variables and +you can give more appropriate diagnostics. + +The default limit is 10 100MB files. If you were to set this +yourself, it would look this way: + +cgi_file_limit 10 100000000 + + +-- File example + +The following code echos the contents of a file that was +uploaded using the variable "file": + + cgi_input + cgi_body { + set server [cgi_import_filename -server $v] + set client [cgi_import_filename -client $v] + if [string length $client] { + h4 "Uploaded: $client, contents:" + cgi_preformatted {puts [exec cat $server]} + } + file delete $server + } + +The present implementation supports binary upload if you are using Tcl +8.1 (or later) or if you are using the Expect extension. If you are +using a version of Tcl earlier than 8.1 with Expect but want to +suppress binary loading, create the global variable +_cgi(no_binary_upload). (The reason you might want to suppress binary +loading is that it is noticably slower.) + +************************************************** +EXPORT +************************************************** + +Form elements automatically export their values. See FORM ELEMENTS +for more information. + +cgi_export name=value + +cgi_export makes the named variable available with the given value. +The "=value" is optional. If not present, the value of the Tcl +variable by the same name is used. + +cgi_export is implemented with variables of type=hidden. + +cgi_export is implemented as an all-or-nothing operation. In +particular, no HTML is emitted if the variable does not exist. That +means it is not necessary to test for existence in situations where +you would like to export a variable IF it exists. Rather, it is +sufficient to embed cgi_export within a catch. For example, the +following generates nothing if xyz doesn't exist and it generates the +appropriate HTML if xyz does exist. + + catch {cgi_export xyz} + +** Cookies + +cgi_export_cookie name + +cgi_export_cookie is similar to cgi_export except that the value is +made available as a cookie. Additional arguments are handled as with +cgi_cookie_set (see below). + +cgi_cookie_set name=val + +cgi_cookie_set sets the named cookie. All optional arguments are +handled specially. All arguments are encoded appropriately. The +expires keyword is handled specially to simplify common cases. In +particular, the values "now" and "never" produce appropriate GMT +values. + +Here are some example of cgi_cookie_set: + + cgi_cookie_set user=don domain=nist.gov expires=never + cgi_cookie_set user=don domain=nist.gov expires=now + cgi_cookie_set user=don domain=nist.gov expires=...actual date... + +Note that cookie setting must be done during http head generation. + +************************************************** +URL/IMG DICTIONARY SUPPORT +************************************************** + +cgi_link tag +cgi_link tag display url + +cgi_link provides a convenient mechanism for maintaining and +referencing from a set of URLs. + +cgi_link returns the string <A>...</A> corresponding to the given tag. +A tag is defined by calling cgi_link with the tag, the clickable text +that the use should see, and the url. + +For example, suppose you want to produce the following (where _xyz_ +indicates xyz is a hyperlink): + + I am married to _Don Libes_ who works in the _Manufacturing + Collaboration Technologies Group_ at _NIST_. + +Using cgi_link with appropriate link definitions, the scripting to +produce this is: + + p "I am married to [link Libes] who works in the [link MCTG] + at [link NIST]." + +This expands to: + + I am married to <A HREF="http://elib.cme.nist.gov/msid/staff + /libes/ libes.don.html">Don Libes</A> who works in the <A + HREF="http:// elib.cme.nist.gov/msid/groups/mctg.htm"> + Manufacturing Collaboration Technologies Group</A> at <A + HREF="http:// www.nist.gov">NIST</A>. + +The links themselves are defined thusly: + + link Libes "Don Libes" http://www.cme.nist.gov/msid/staff/libes + link MCTG "$MCT Group" http://www.cme.nist.gov/msid/mctg + link NIST "NIST" http://www.nist.gov + +Now if my home page ever changes, rather than updating every +occurrence, I just have to edit the one definition. + +Tcl variables can further simplify updates. For instance, URLs for +Libes and MCTG are in a common directory. It makes sense to store +that in a single variable. Rewritten this appears: + +set MSID http://www.cme.nist.gov/msid + + link Libes "Don Libes" $MSID/staff/libes + link MCTG "$MCT Group" $MSID/mctg + link NIST "NIST" http://www.nist.gov + +Then if the MSID directory ever moves, only one line need be updated. +This may seem like no big deal here, but if you have many links and +many uses of them, this pays off handsomely. + +Optional attributes can be provided as additional arguments (see IMG +example below). + +An existing link can be given a different "display" temporarily by +calling cgi_link with the different display and omitting the url. + +cgi_imglink + +imglink works similar to cgi_link (see that documentation for more +info) except that no display argument is used and the second argument +is assumed to be the image source. Example: + + imglink taj tajmahal.gif + +Other attributes can be provided as additional arguments. + + imglink taj tajmahal.gif "alt=The Taj Mahal" + +cgi_url display href args + +By using cgi_url, URLs can be generated immediately (without using +cgi_link first). This is convenient when you need a URL that will +only appear once - so that there is no point in storing it in a +dictionary. For example: + + cgi_li "[cgi_url "Plume" http://pastime.anu.edu.au/Plume] + is a Tcl-based WWW browser written by Steve Ball, + Australian National University. Among its interesting + features is the ability to execute Tcl applets and the + ability to dynamically extend the browser at runtime." + +cgi_img href args + +cgi_img returns a formatted <img> tag. It is useful for one-time tags. +Tags that are used multiple times should use cgi_imglink. Example: + + cgi_img foo.gif "alt=Foo's Bar & Grill" + +cgi_anchor_name name + +cgi_anchor_name returns an anchor that can be used in an HTML body +that it can be linked to using the #name syntax. For example, to make +a heading that you want to be able to link to: + + h2 "[cgi_anchor_name future]Future Improvements" + +Then to reference the "future" tag: + + p "Look for [cgi_url "improvements" #future] in the future." + +cgi_base args + +cgi_base defines a base or window target for urls. + +************************************************** +QUOTING +************************************************** + +cgi_unquote_input string + +cgi_unquote_input undoes "url-encoding" and returns the result. This +is normally applied automatically to input sources including URLs and +cookies. So you shouldn't have to call this manually. + +cgi_quote_html string + +cgi_quote_html returns the string but with any html-special characters +escaped. For example, "<" is replaced by "\<". This is useful for +displaying a literal "<" in the browser. + +cgi_dquote_html string + +cgi_dquote_html does the same thing as cgi_quote_html but also adds on +double quotes. cgi_quote_html is called automatically for implicit +value attributes. + +cgi_quote_url string + +cgi_quote_url quotes strings appropriately to appear in a url, cookie, +etc. This is useful if you want to publish a url by hand (and must do +the conversion manually that the client normally does for you). + +If you are generating cgi-style URLs for forms, use cgi_cgi_set. + +cgi_preformatted cmd + +cgi_preformatted evaluates its last argument to produce fixed-width +preformatted output. Optional arguments are passed as attributes to +the tags. + +cgi_preformatted allows a subset of tags to be interpreted by the +browser. For example, the <a> tag is interpreted but font change tags +are not. To prevent all interpretation, use cgi_quote_html. For +example, the following prints a file that might contain HTML but +without any risk to throwing off formatting. + + cgi_preformatted { + puts [cgi_quote_html [read $fid]] + } + +************************************************** +LIST SUPPORT +************************************************** + +** List elements + +cgi_li string + +cgi_li prints its string as a list element. Optional arguments are +passed through as attributes. cgi_li does not have to appear in a +list container, but it can. + +cgi_term text +cgi_term_definition text + +cgi_term and cgi_term_definition are usually paired up (although they +need not be) to creates terms and defintions. They do not have to +appear in a list container, but usually appear in a cgi_definition_list. + +** List containers + +cgi_number_list cmd +cgi_bullet_list cmd + +cgi_number_list and cgi_bullet_list take their cmd argument and +evaluate it in a list container context. (I don't know about you but +I could never remember <ol>, <ul>, and all the other ones. This names +seem much easier to remember.) + +cgi_li is a typical command to call inside of a list container, but +you can use regular paragraphs (or anything else) as well. + +cgi_definition_list + +cgi_definition_list is the usual list container for cgi_term and +cgi_term_definition. It may contain other things as well. + +cgi_menu_list +cgi_directory_list + +cgi_menu_list and cgi_directory are more list containers with the +obvious semantics. Previous remarks about other list containers +apply. + +************************************************** +TABLE +************************************************** + +cgi_table cmd + +cgi_table produces <table></table> tags with the content filled by +evaluation of cmd. Optional arguments are passed on as attributes. + +cgi_caption cmd + +cgi_caption produces <caption></caption> tags with the content filled +by evaluation of cmd. Optional arguments are passed on as attributes. + +cgi_table_row cmd +cgi_table_head cmd +cgi_table_data cmd + +These functions all produce the appropriate tags with the content +filled by evaluation of cmd. Optional arguments are passed on as +attributes. + +cgi_tr table_data +cgi_td table_data +cgi_th table_data + +cgi_tr, cgi_td, and cgi_th are shortcuts for relatively simple rows. + +cgi_td outputs a table element. Unlike cgi_table_data, the argument +is not evalled. This allows more terse specification of simple rows. +The following example produces a table with three elements, the last +of which is prevented from wrapping: + + table_row {td Don;td Steve;td nowrap "Really Long Name"} + +As the example suggests, optional arguments are passed on as +data-specific attributes. + +cgi_th is identical to cgi_td except that it produces table heading +elements. + +cgi_tr outputs a row of elements without having to call cgi_td or +cgi_table_data. As with td, eval is not called. Data-specific +attributes cannot be provided. All the elements are passed as a +single argument. For example: + + tr {Don Steve {Really Long Name}} +or + tr [list Don Steve $reallylongname] + +Optional arguments are passed on as row-specific attributes. + +************************************************** +BUTTON +************************************************** + +cgi_submit_button name=value +cgi_radio_button name=value +cgi_image_button name=value + +These procedure create buttons. The first argument indicates the +variable name and value. (See notes on "Name-value" commands earlier +to understand behavior of omitted names/values.) Unless otherwise +mentioned below, additional arguments are passed on as attributes. + + cgi_submit_button "=Submit Form" + cgi_submit_button "Action=Pay Raise" + + cgi_radio_button "version=1" + cgi_radio_button "version=2" checked=1 + + cgi_image_button "=http://www.cme.nist.gov/images/title.gif" + cgi_image_button "Map=http://www.cme.nist.gov/images/msid3.gif" + +Groups of radio buttons must share the same variable name. To address +the obvious question: No, there is no single command to produce a +group of radio buttons because you might very well want to do +arbitrarily-complex calculations in between them. And with a +long-enough line of buttons, the obvious behavior (laying them all out +in a line like CGI.pm does) makes it hard to tell at a glance if the +buttons associate with the label to the left or the right of them. +Anyway, you'll almost certainly want to write another procedure to +call cgi_radio_button and that can control the variable name. + +The radio button argument "checked_if_equal=xxx" indicates that the +button should be shown selected if its associated value is xxx. This +is handy if you are creating radio buttons by iterating over a list. + +The radio button "checked=value" indicates that the button should be +shown selected if the value is a boolean of value true. + +All other arguments are passed on as attributes. + +cgi_file_button name + +cgi_file_button provides a filename entry box. When the form is +submitted, the file is "uploaded" (sent from the client to the +server). The argument enctype=multipart/form-data must be given to +the cgi_form command when using cgi_file_button. + +After uploading, the file is the responsibility of the CGI programmer. +In particular, if you do not delete it, it will remain until /tmp is +cleaned up in some other way. + +For example, to upload a single file, the form might look like this: + + cgi_form upload height=3 enctype=multipart/form-data { + cgi_file_button file + cgi_submit_button =Upload + } + +Uploaded files are automatically made available to the CGI script +using cgi_import_filename. (See elsewhere for more information.) + +cgi_reset_button value + +cgi_reset_button creates a a reset button. An argument overrides the +default label. For example: + + cgi_reset_button + cgi_reset_button "Not the Default Reset Button" + +cgi_map name cmd +cgi_area args + +These procedures are used to specify client-side image maps. The +first argument of cgi_map is the map name. The last argument is +evaluated to fill the contents of <map></map> tags. cgi_area's +arguments are embedded as arguments in an <area> tag. + +Warning: These two commands will likely be redefined as I get more +familiar with how they are typically used. + +************************************************** +CHECKBOX +************************************************** + +cgi_checkbox name=value + +cgi_checkbox is similar to cgi_radio_button (see above) except that +multiple values can be checked at the same time. As explained +earlier, the variable name must end with "List" in order for it to +group all the values as a list in the resulting CGI script. + +The argument "checked_if_equal=xxx" which indicates that the current +name should be shown selected if its associated value is xxx. This is +handy if you are creating checkboxes by iterating over a list. + +The argument "checked=value" indicates that the checkbox should be +shown selected if the value is a boolean of value true. + +Other arguments are passed on as attributes. + + +************************************************** +TEXTENTRY AND TEXTAREA +************************************************** + +cgi_text name=value + +cgi_text provides a one-line text entry box. It works similarly to +other form elements. (Read "Name-value commands" elsewhere.) +Additional arguments are passed on as attributes. Examples: + + cgi_text Foo + cgi_text Foo= + cgi_text Foo=value2 + cgi_text Foo=value2 size=5 + cgi_text Foo=value2 size=5 maxlength=10 + cgi_text Foo=value2 size=10 maxlength=5 + cgi_text Foo=value2 maxlength=5 + +cgi_textarea name=value + +cgi_textarea provides a multiline text entry box. It works similarly +to other form elements. (Read "Name-value commands" elsewhere.) +Additional arguments are passed on as attributes. + + set value "A really long line so that we can compare the\ + effect of wrap options." + + cgi_textarea Foo + cgi_textarea Foo= + cgi_textarea Foo=$value + cgi_textarea Foo=$value rows=3 + cgi_textarea Foo=$value rows=3 cols=7 + cgi_textarea Foo=$value rows=3 cols=7 wrap=virtual + +************************************************** +SELECT +************************************************** + +cgi_select name cmd + +cgi_select can be used to produce pull-down menus and scrolled lists. +(And depending upon the future of HTML, I may provide better-named +commands to indicate this.) Its behavior is controlled by additional +arguments which are simply the appropriate attributes. + +cgi_select evaluates cmd which typically contains multiple calls to +cgi_option. + +cgi_option string + +cgi_option adds options to cgi_select. By default, the string is +displayed and sent back as the value of the cgi_select variable. The +value can be overridden by an explicit "value=" argument. Additional +options are passed on as attributes, except for "selected_if_equal". + +"selected_if_equal=xxx" indicates that the current option should be +shown selected if the value is equal to xxx. This is useful if you +are generating cgi_options in a loop rather than manually. + +Here are examples: + + # pull-down menu + cgi_select Foo { + cgi_option one selected + cgi_option two + cgi_option many value=hello + } + + # scrolled list, allow multiple selections, show all elements + cgi_select FooList multiple { + cgi_option one selected + cgi_option two selected + cgi_option many + } + + # scrolled list, allow multiple selections, show 2 elements max + cgi_select FooList multiple size=2 { + cgi_option one selected + cgi_option two selected + cgi_option many + } + + # choose "selected" dynamically + # example: list all Tcl command and select "exit" automatically + cgi_select FooList multiple size=5 { + foreach o [info comm] { + cgi_option $o selected_if_equal=exit + } + } + +Note: If both value= and selected_if_equal= appear, the test for +selection is made against the last value string (implicit or explicit) +that appears before the selected_if_equal argument. In other words, +if you want selected_if_equal= to be tested against the explicit +value= argument, put the selected_if_equal= *after* the value=. + +************************************************** +APPLET +************************************************** + +cgi_applet parameters cmd + +cgi_applet produces <applet></applet> tags such as for Java. + +cgi_param name=value + +cgi_param produces <param> tags for passing parameters to applets. + +For example: + + cgi_applet "codebase=../" "code=some.class" width=640 height=480 { + cgi_param parm=value + } + +************************************************** +PLUG-IN +************************************************** + +cgi_embed src widthxheight + +cgi_embed creates an <embed> tag. The first argument is the source. +The second argument is the width and height in the style "WxH". +Optional arguments are passed on to the tag. For example: + + cgi_embed myavi.avi 320x200 autostart=true + +produces: + + <embed src="myavi.avi" width="320" height="200" autostart=true> + +Notice the autostart value is unquoted because autostart is not +specifically defined by the spec. The argument "-quote" causes all +remaining attributes to be url encoded and quoted. For example: + + cgi_embed myavi.avi 320x200 a=b -quote c=d e=f + +produces: + + <embed src="myavi.avi" width="320" height="200" a=b c="d" e="f"> + +************************************************** +MISC +************************************************** + +cgi_hr + +cgi_hr produces horizontal rules. Optional arguments are passed on as +attributes. + +************************************************** +COMMENTS +************************************************** + +cgi_comment stuff + +cgi_comment can comment out anything including blocks of code. + +cgi_html_comment stuff + +cgi_html_comment comments out things in such a way that the comment +appears in the final html itself. + +************************************************** +OUTPUT +************************************************** + +cgi_put string + +cgi_put prints the string with no new terminating newline. This is +simply a shorthand for puts -nonewline. + +cgi_puts + +Many routines in this library send output to the standard output by +default. This is convenient for CGI scripts. However, if you want to +generate multiple files, it is useful to be able to redirect output +dynamically. Output can be redirected by redefining cgi_puts. The +default definition of cgi_puts is: + + proc cgi_puts {args} { + eval puts $args + } + +cgi_puts must allow for an optional -nonewline argument. For example, +here is a definition that writes to a file identified by the global +"fd". + + proc cgi_puts {args} { + global fd + + puts -nonewline $fd [lindex $args end] + if {[llength $args] > 1} { + puts $fd "" + } + } + +cgi_buffer cmd + +cgi_buffer evaluates its argument in such a way that output (through +explicit or implicit calls to cgi_puts) is not produced. Instead, the +output is returned. + +For example, the following cmd generates a link with the hyperlinked +portion being a header and two paragraphs. + + link tag [cgi_buffer { + h3 "Level 3 header" + p "New paragraph" + p "Another paragraph" + }] $URL + +cgi_buffer can be called recursively. + +cgi_buffer_nl string + +By default, cgi_buffer generates newlines at the end of every line in +the style of puts. It is occasionally useful to be able to disable +this - for example, when calling it inside cgi_preformatted. The +newline definition can be changed via cgi_buffer_nl. (There is no +point to redefining cgi_puts since cgi_buffer doesn't use it.) A null +argument suppresses any newline. For example: + + cgi_buffer_nl "" + +cgi_buffer_nl returns the previous definition. + +************************************************** +MAIL +************************************************** + +Rudimentary email support is provided, in part, because it is useful +for trapping errors - if debugging is disabled (i.e., during actual +use) and an error is encountered, errors are emailed to the service +admin. + +The current implementation only permits one email transaction at a +time. + +cgi_mail_addr addr + +cgi_mail_addr defines the email address that mail comes from. Your +email system must allow this, of course. (If your system doesn't +allow it, the request is usually ignored.) + +cgi_mail_start addr + +cgi_mail_start creates a mail message to be delivered the given addr. +cgi_mail_add should be used to provide a subject and body. + +cgi_mail_add string + +cgi_mail_add adds strings to the current mail message. No argument +causes a blank line to be added. + +cgi_mail_end + +cgi_mail_end queues the the current mail message for delivery. + + cgi_mail_start libes@nist.gov + cgi_mail_add "Subject: [cgi_name] request succeeded + cgi_mail_add + cgi_mail_add "Your request has been processed." + cgi_mail_add "Thanks for using [cgi_name]. + cgi_mail_end + +cgi_mail_relay host + +cgi_mail_relay identifies a host to be used for mail relay services. +(This is currently only used when sendmail support is not available.) +If a relay is not defined, email is sent directly to the recipient. + +************************************************** +INITIALIZATION +************************************************** + +cgi_init + +The package initializes itself upon initial loading, however it can be +explicitly initialized by calling cgi_init. This is useful in +environments such as tclhttpd. diff --git a/web/src/cgi.tcl-1.10/example/README b/web/src/cgi.tcl-1.10/example/README new file mode 100644 index 00000000..6bbbb80c --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/README @@ -0,0 +1,77 @@ +This file is cgi.tcl/README. It contains brief descriptions of the +examples in this directory. You are welcome to send me additional +scripts. + +-------------------- +Instructions on running scripts +-------------------- + +The "examples.cgi" script provides a page of clickable links to all +the other example scripts. "frame.cgi" is a framed version - it's not +particularly good looking but it does work and - anyway - I needed a +frame example! + +There are three ways of running these scripts: + +1) Point your browser at http://expect.nist.gov/cgi.tcl + +2) Run them by hand, such as by typing "tclsh scriptname" at the +command line. This is appropriate if you just want to study the raw +HTML output or see how fast they run. + +3) Install them in your own web and run them through your browser. +(If you're on a UNIX host, the "make examples" target in the Makefile +fixes up the #! line of each examples and installs them in a public +demo directory.) You'll want to edit the example.tcl file to redefine +cgi_root appropriately. + +If you run the examples locally (options 2 and 3): + + - In order to get the submit buttons to take you back to your + site (instead of on to my site!), check the cgi_root call in + example.tcl to point back to your site. + + - Some of these examples may do things that are not portable + and therefore may not run on all systems. For example, some + of them call "exec". The "unimail" script assumes the + existence of sendmail through cgi.tcl's built-in mail + support. See the ../install.win file for more info. + +-------------------- +Source files in this directory +-------------------- + + cookie.cgi - demonstrates cookies + + display.cgi - display a CGI script + + error.cgi - demonstrates error handing + + examples.cgi - Provides a page with clickable links to all + these examples. + + form-tour.cgi - demonstrates most form elements (Note that these + don't do anything - they're just for looks.) + + format-tour.cgi - demonstrates many formats, unrelated to forms + + frame.cgi - a friend's home page that demonstrates frames + + kill.cgi - kill runaway CGI processes + + parray.cgi - displays an array (or the environment by default) + + passwd-form.cgi - creates a form for changing a password + passwd.cgi - backend to passwd-form where password is actually changed + Note that this script is an Expect script. + passwd.tcl - common definitions for passwd*.cgi scripts + + upload.cgi - file upload + + vclock.pl - Lincoln Stein's virtual clock from CGI.pm paper + vclock.cgi - Lincoln Stein's virtual clock (but in Tcl) + + visitor.cgi - implements a visitor counter + visitor.cnt - file containing the count + + example.tcl - common definitions for most of the examples diff --git a/web/src/cgi.tcl-1.10/example/cookie.cgi b/web/src/cgi.tcl-1.10/example/cookie.cgi new file mode 100755 index 00000000..ea0709bc --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/cookie.cgi @@ -0,0 +1,45 @@ +#!/depot/path/tclsh + +# This CGI script shows how to create a cookie. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_http_head { + cgi_content_type text/html + if {0==[catch {cgi_import Name}]} { + cgi_export_cookie Name ;# expires=never + # For a persistent cookie, uncomment the "expires=never" + } else { + catch {cgi_import_cookie Name} + } + } + cgi_head { + cgi_title "Cookie Form Example" + } + cgi_body { + p "This form finds a value from a previous submission of \ + the form either directly or through a cookie." + set Name "" + + if {0==[catch {cgi_import Name}]} { + p "The value was found from the form submission and the cookie + has now been set. Bookmark this form, surf somewhere else + and then return to this page to get the value via the cookie." + } elseif {0==[catch {cgi_import_cookie Name}]} { + p "The value was found from the cookie." + } else { + p "No cookie is currently set. To set a cookie, enter a value + and press return." + } + + cgi_form cookie { + puts "Value: " + cgi_text Name + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/creditcard.cgi b/web/src/cgi.tcl-1.10/example/creditcard.cgi new file mode 100755 index 00000000..a205b452 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/creditcard.cgi @@ -0,0 +1,137 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + set cardtypes { + "American Express" + "Carte Blanche" + "Diners Card" + "Discover" + "Enroute" + "JCB" + "Mastercard" + "Novus" + "Visa" + } + + # My own version of the LUHN check + proc LUHNFormula {cardnumber} { + if {0==[regexp "(.*)(.)$" $cardnumber dummy cardnumber check]} { + user_error "No card number entered" + } + set evenodd [expr [string length $cardnumber] % 2] + + set sum 0 + foreach digit [split $cardnumber ""] { + incr sum $digit + if {$evenodd} { + incr sum [lindex {0 1 2 3 4 -4 -3 -2 -1 0} $digit] + } + set evenodd [expr !$evenodd] + } + set computed [expr {(10 - ($sum % 10)) % 10}] + if {$computed != $check} { + user_error "Invalid card number. (Failed LUHN test - try changing last digit to $computed.)" + } + } + + # generate digit patterns of length n + proc d {n} { + for {set i 0} {$i < $n} {incr i} { + append buf {[0-9]} + } + return $buf + } + + cgi_input + + cgi_title "Check Credit Card" + + cgi_body { + if {0 == [catch {cgi_import cardtype}]} { + if {[catch {cgi_import cardnumber}]} { + user_error "No card number entered" + } + # Save original version for clearer diagnostics + set originalcardnumber [cgi_quote_html $cardnumber] + + if {[catch {cgi_import expiration}]} { + user_error "You must enter an expiration." + } + if {-1 == [lsearch $cardtypes $cardtype]} { + user_error "Unknown card type: $cardtype" + } + + # Remove any spaces or dashes in card number + regsub -all "\[- ]" $cardnumber "" cardnumber + + # Make sure that only digits are left + if {[regexp "\[^0-9]" $cardnumber invalid]} { + user_error "Invalid character ([cgi_quote_html $invalid]) in credit card number: $originalcardnumber" + } + + if {$cardtype != "Enroute"} { + LUHNFormula $cardnumber + } + + # Verify correct length and prefix for each card type + switch $cardtype { + Visa { + regexp "^4[d 12]([d 3])?$" $cardnumber match + } Mastercard { + regexp "^5\[1-5][d 14]$" $cardnumber match + } "American Express" { + regexp "^3\[47][d 13]$" $cardnumber match + } "Diners Club" { + regexp "^3(0\[0-5]|\[68][d 1])[d 11]$" $cardnumber match + } "Carte Blanche" { + regexp "^3(0\[0-5]|\[68][d 1])[d 11]$" $cardnumber match + } Discover { + regexp "^6011[d 12]$" $cardnumber match + } Enroute { + regexp "^(2014|2149)[d 11]$" $cardnumber match + } JCB { + regexp "^(2131|1800)[d 11]$" $cardnumber match + regexp "^3(088|096|112|158|337|528)[d 12]$" $cardnumber match + } Novus { + if {[string length $cardnumber] == 16} { + set match 1 + } + } + } + + if 0==[info exists match] { + user_error "Invalid card number: $originalcardnumber" + } + h3 "Your card appears to be valid. Thanks!" + return + } + + cgi_form creditcard { + h3 "Select a card type, enter the card number and expiration." + puts "Card type: " + cgi_select cardtype { + foreach t $cardtypes { + cgi_option $t + } + } + puts "[nl]Card number: " + cgi_text cardnumber= + puts "(blanks and dashes are ignored)" + + puts "[nl]Expiration: " + cgi_text expiration= + + br + submit_button "=Confirm purchase" + reset_button + h5 "This script will perform all of the known syntactic + checks for each card type but will not actually contact + a credit bureau. The expiration field is not presently + checked at all." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/display-in-frame.cgi b/web/src/cgi.tcl-1.10/example/display-in-frame.cgi new file mode 100755 index 00000000..6366957e --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/display-in-frame.cgi @@ -0,0 +1,31 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays the results of other CGI scripts +# in a separate frame. It is only used for a few rare examples such +# as image.cgi + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_head { + set scriptname image.cgi + catch {cgi_import scriptname} + set scriptname [file tail $scriptname] + cgi_title $scriptname + } + cgi_frameset rows=50%,50% { + cgi_frame =$scriptname?header=1 + cgi_frame =$scriptname + } + cgi_noframes { + cgi_h1 "uh oh" + + p "This document is designed to be viewed by a Frames-capable + browser. If you see this message your browser is not + Frames-capable." + } +} diff --git a/web/src/cgi.tcl-1.10/example/display.cgi b/web/src/cgi.tcl-1.10/example/display.cgi new file mode 100755 index 00000000..efadbe05 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/display.cgi @@ -0,0 +1,44 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays another CGI script +# and massages "source" commands into hyperlinks + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_head { + set scriptname [info script]; # display self by default! + catch {cgi_import scriptname} + + # strip tildes to gracefully handle experimenters + set scriptname [string trimleft $scriptname ~] + + set scriptname [file tail $scriptname] + cgi_title "Source for $scriptname" + } + cgi_body { + # gracefully handle hackers trying to opening directories + switch -- $scriptname . - .. - "" { + h3 "No such file: $scriptname" + return + } + if {[catch {set fid [open $scriptname]}]} { + h3 "No such file: $scriptname" + return + } + cgi_preformatted { + while {-1 != [gets $fid buf]} { + if {[regexp "^(\[ \t]*)source (.*)" $buf ignore space filename]} { + puts "[set space]source [cgi_url $filename [cgi_cgi display scriptname=$filename]]" + } else { + puts [cgi_quote_html $buf] + } + } + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/download.cgi b/web/src/cgi.tcl-1.10/example/download.cgi new file mode 100755 index 00000000..c82cb3f5 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/download.cgi @@ -0,0 +1,36 @@ +#!/depot/path/tclsh + +package require cgi + +set msg "Very funny, Scotty. Now beam down my clothes." +set filename "scotty.msg" + +cgi_eval { + source example.tcl + + cgi_input + + if {[catch {cgi_import style}]} { + cgi_title "download example" + body { + cgi_suffix "" + form download.cgi/$filename { + puts "This example demonstrates how to force files to be + downloaded into a separate file via the popup file browser." + br + puts "Download data" + submit_button "style=in window" + submit_button "style=in file using popup file browser" + } + } + } else { + if {[regexp "in window" $style]} { + title "Display data in browser window" + } else { + cgi_http_head { + content_type application/x-download + } + } + puts $msg + } +} diff --git a/web/src/cgi.tcl-1.10/example/error.cgi b/web/src/cgi.tcl-1.10/example/error.cgi new file mode 100755 index 00000000..0b97c99a --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/error.cgi @@ -0,0 +1,31 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates error processing. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_title "This CGI script contains an intentional error." + + cgi_body { + p "The page that you are now reading is being generated by a + CGI script that contains an intentional error." + + cgi_debug -on + + p "Debugging is enabled, so the error message will be shown in +the browser window (below). Disable this by commenting out the +cgi_debug command and reloading this script." + + cgi_number_list { + cgi_li "List item 1" + cgi_li "List item 2" + cgi_lix "List item 3 - intentionally misspelled" + cgi_li "List item 4" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/evaljs.cgi b/web/src/cgi.tcl-1.10/example/evaljs.cgi new file mode 100755 index 00000000..ea732e9d --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/evaljs.cgi @@ -0,0 +1,36 @@ +#!/depot/path/tclsh + +# This CGI script uses JavaScript to evaluate an expression. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_head { + title "Using JavaScript to evaluate an expression" + + javascript { + puts { + function compute(f) { + f.result.value = eval(f.expr.value) + } + } + } + noscript { + puts "Sorry - your browser doesn't understand JavaScript." + } + } + + cgi_body { + cgi_form dummy { + cgi_unbreakable { + cgi_button "Evaluate" onClick=compute(this.form) + cgi_text expr=Math.sqrt(2)*10000 + puts "=" + cgi_text result= + } + p "Feel free to enter and evaluate your own JavaScript expression." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/example.tcl b/web/src/cgi.tcl-1.10/example/example.tcl new file mode 100644 index 00000000..c1246621 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/example.tcl @@ -0,0 +1,82 @@ +# common definitions for all examples + +# cgi_debug -on + +set NIST_HOST http://www.nist.gov +set MSID_HOST http://www.nist.gov +set EXPECT_HOST http://expect.nist.gov +set EXPECT_ART $EXPECT_HOST/art +set MSID_STAFF $MSID_HOST/msidstaff +set CGITCL $EXPECT_HOST/cgi.tcl +set DATADIR data + +set domainname "unknown" +catch {set domainname [exec domainname]} + +# prevent everyone in the world from sending specious mail to Don! +if {($domainname == "cme.nist.gov") || ([info hostname] == "ats.nist.gov")} { + cgi_admin_mail_addr libes@nist.gov +} + +set TOP target=_top +cgi_link NIST "NIST" $NIST_HOST $TOP +cgi_link Don "Don Libes" $MSID_STAFF/libes $TOP +cgi_link admin "your system administrator" mailto:[cgi_admin_mail_addr] +cgi_link CGITCL "cgi.tcl homepage" $CGITCL $TOP +cgi_link examples "list of examples" [cgi_cgi examples] $TOP +cgi_link realapps "real applications" $CGITCL/realapps.html $TOP +cgi_link Expect "Expect" $EXPECT_HOST $TOP +cgi_link Oratcl "Oratcl" http://www.nyx.net/~tpoindex/tcl.html#Oratcl $TOP + +cgi_imglink logo $EXPECT_ART/cgitcl-powered-feather.gif align=right "alt=powered-by-cgi.tcl logo" +cgi_link logolink [cgi_imglink logo] $CGITCL $TOP + +# Allow for both my development and production environment. And people +# who copy this to their own server and fail to change cgi_root will get +# my production environment! +if {$domainname == "cme.nist.gov"} { + cgi_root "http://www-i.cme.nist.gov/cgi-bin/cgi-tcl-examples" +} else { + cgi_root "http://ats.nist.gov/cgi-bin/cgi.tcl" +} + +proc scriptlink {} { + if {0==[catch {cgi_import framed}]} { + set target "target=script" + } else { + set target "" + } + + cgi_url "the Tcl script" [cgi_cgi display scriptname=[info script]] $target +} + +proc app_body_start {} { + h2 [cgi_title] + puts "See [scriptlink] that created this page." + hr +} + +proc app_body_end {} { + hr; puts "[cgi_link logolink]" + puts "Report problems with this script to [link admin]." + br; puts "CGI script author: [link Don], [link NIST]" + br; puts "Go back to [link CGITCL] or [link examples]." +} + +cgi_body_args bgcolor=#00b0b0 text=#ffffff + +proc user_error {msg} { + h3 "Error: $msg" + cgi_exit +} + +# support for rare examples that must be explicitly framed +proc describe_in_frame {title msg} { + if {0 == [catch {cgi_import header}]} { + cgi_title $title + cgi_body { + p $msg + } + exit + } +} diff --git a/web/src/cgi.tcl-1.10/example/examples.cgi b/web/src/cgi.tcl-1.10/example/examples.cgi new file mode 100755 index 00000000..75afb1e9 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/examples.cgi @@ -0,0 +1,81 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + input + + title "cgi.tcl examples" + + # use targets if we are framed + if {0==[catch {import framed}]} { + set target "target=script" + } else { + set target "" + } + + # create a hyperlink to run a script + proc run {name} { + url $name.cgi [cgi $name] [uplevel {set target}] + } + + # create hyperlink to show script source + proc display {name} { + url $name.cgi [cgi display scriptname=$name.cgi] [uplevel {set target}] + } + + body bgcolor=#d0a0a0 text=#000000 { + p "These are examples of cgi.tcl, a CGI support library for Tcl + programmers. If you would like to show off what you've + written with cgi.tcl, give me an html-formatted blurb and I'll + add it to a page of [link realapps]. For more information, + visit the [link CGITCL]." + + bullet_list { + li "[run cookie] - Cookie example. Also see [run passwd-form] to see cookies in the context of a real application." + li "[run creditcard] - Check a credit card." + li "[run download] - Demonstrate file downloading. Also see [run upload]." + li "[run echo] - Echo everything - good for debugging forms." + li "[run error] - Error handling example." + li "[run evaljs] - Evaluate an expression using JavaScript." + li "[run examples] - Generate the page you are now reading." + li "[run form-tour] and [display form-tour-result] - Show + many different form elements and the backend to process them." + li "[run format-tour] - Demonstrate many formats." + li "[run frame] - Framed example (of this page)." + li "[url "image.cgi" [cgi display-in-frame [cgi_cgi_set scriptname \ + image.cgi]] $target] - Produce a raw image." + li "[run img] - Examples of images embedded in a page." + li "[run kill] - Allow anyone to kill runaway CGI processes." + li "[display oratcl] - Use [link Oratcl] to query an Oracle database." + li "[run nistguest] - Specialized guestbook" + li "[run parray] - Demonstrate parray (print array elements)." + li "[run passwd-form] and [display passwd] - Form for + changing a password and its backend. Note that this CGI script + is [bold not] setuid because it is written using [link Expect]. + The script also demonstrates a nice use of cookies." + li "[run push] - Demonstrate server-push." + li "[run rm] - Allow anyone to remove old CGI files from /tmp." + li "[run stopwatch] - A stopwatch written as a Tcl applet." + li "[display unimail] - A universal mail backend that mails the + values of any form back to the form owner." + li "[run upload] - Demonstrate file uploading. Also see [run download]." + li "[run utf] - Demonstrate UTF output." + li "[run validate] - Validate input fields using JavaScript." + li "[run vclock] - Lincoln Stein's virtual clock. + This was the big example in his CGI.pm paper. Examine the + source to [eval url [list "his Perl version"] \ + [cgi display scriptname=vclock.pl] $target] or compare them + [url "side by side" [cgi vclock-src-frame] target=script2]." + li "[run visitor] - Example of a visitor counter." + li "[run version] - Show version information." + li "[run vote] - Vote for a quote." + li "[run display] - Display a CGI script with clickable + source commands. Not a particularly interesting application - + just a utility to help demo these other CGI scripts! But it is + written using cgi.tcl so it might as well be listed here." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/form-tour-result.cgi b/web/src/cgi.tcl-1.10/example/form-tour-result.cgi new file mode 100755 index 00000000..d1278ecf --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/form-tour-result.cgi @@ -0,0 +1,69 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows the result of the form tour. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + cgi_title "Form Element Tour Results" + + cgi_body { + h4 "This is a report of variables set by the form tour." + + if {0!=[catch {cgi_import Foo0}]} { + h5 "Error: It appears that you have invoked this script + without going through [cgi_url "the intended form" [cgi_cgi form-tour]]." + cgi_exit + } + + catch { + cgi_import Map.x + cgi_import Map.y + puts "image button coordinates = ${Map.x},${Map.y}[nl]" + } + + catch { + cgi_import Action + puts "submit button Action=$Action[nl]" + br + } + + foreach x {version A B C D} { + catch { + cgi_import $x + puts "radio button \"$x\": [set $x][nl]" + } + } + catch { + cgi_import VegieList + puts "checkbox Vegielist = $VegieList[nl]" + } + for {set i 0} {$i<=6} {incr i} { + set var Foo$i + cgi_import $var + puts "text $var:" + cgi_preformatted { + puts [set $var] + } + } + for {set i 0} {$i<=9} {incr i} { + set var Foo1$i + cgi_import $var + puts "textvar $var:" + cgi_preformatted { + puts [set $var] + } + } + catch { + cgi_import Foo + puts "select pull-down Foo: $Foo[nl]" + } + catch { + cgi_import FooList + puts "select scrolled list FooList: $FooList[nl]" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/form-tour.cgi b/web/src/cgi.tcl-1.10/example/form-tour.cgi new file mode 100755 index 00000000..7e5e49d5 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/form-tour.cgi @@ -0,0 +1,123 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows a selection of form elements +# This script doesn't actually DO anything. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "A Tour of Form Elements" + + cgi_body { + form form-tour-result { + h4 "Samples of image button" + cgi_put "image as button" + cgi_image_button "=http://www.nist.gov/msidimages/title.gif" + br + cgi_put "image as button (and will return coords)" + cgi_image_button "Map=http://www.nist.gov/public_affairs/gallery/fireseat.jpg" + + h4 "Samples of submit button" + cgi_submit_button + cgi_submit_button ="Submit" + cgi_submit_button "=Submit Form" + cgi_submit_button "Action=Pay Raise" + + h4 "Samples of reset button" + cgi_reset_button + cgi_put "Default Reset Button" + br + cgi_reset_button "Not the Default Reset Button" + cgi_put "Not the Default Reset Button" + + h4 "Samples of radio button" + cgi_radio_button "version=1" + cgi_put "Version 1" + br + cgi_radio_button "version=2" + cgi_put "Version 2" + br + cgi_radio_button "version=3" checked + cgi_put "Version 3" + + br + foreach x {A B C D} { + cgi_radio_button "$x=" checked_if_equal=B + cgi_put "$x" + br + } + + h4 "Samples of checkbox" + cgi_checkbox VegieList=carrot + cgi_put "Carrot" + br + cgi_checkbox VegieList=rutabaga checked + cgi_put "Rutabaga" + br + cgi_checkbox VegieList= + cgi_put "Vegie" + + h4 "Samples of textentry" + set Foo0 "value1" + set Foo1 "value1" + cgi_text Foo0 + br;cgi_text Foo1= + br;cgi_text Foo2=value2 + br;cgi_text Foo3=value2 size=5 + br;cgi_text Foo4=value2 size=5 maxlength=10 + br;cgi_text Foo5=value2 size=10 maxlength=5 + br;cgi_text Foo6=value2 maxlength=5 + + h4 "Samples of textarea" + + set value "A really long line so that we can compare the\ + effect of wrap options." + + set Foo10 "value1" + set Foo11 "value1" + cgi_textarea Foo10 + br;cgi_textarea Foo11= + br;cgi_textarea Foo12=$value + br;cgi_textarea Foo13=$value rows=3 + br;cgi_textarea "Foo14=default wrap" rows=3 cols=7 + br;cgi_textarea Foo15=wrap=off rows=3 cols=7 wrap=off + br;cgi_textarea Foo16=wrap=soft rows=3 cols=7 wrap=soft + br;cgi_textarea Foo17=wrap=hard rows=3 cols=7 wrap=hard + br;cgi_textarea Foo18=wrap=physical rows=3 cols=7 wrap=physical + br;cgi_textarea Foo19=wrap=virtual rows=3 cols=7 wrap=virtual + + h4 "Samples of select as pull-down menu" + cgi_select Foo { + cgi_option one selected + cgi_option two + cgi_option many value=hello + } + + h4 "Samples of select as scrolled list" + cgi_select FooList multiple { + cgi_option one selected + cgi_option two selected + cgi_option many + } + br + cgi_select FooList multiple size=2 { + cgi_option two selected + cgi_option three selected + cgi_option manymore + } + br + # choose "selected" dynamically + cgi_select FooList multiple size=5 { + foreach o [info comm] { + cgi_option $o selected_if_equal=exit + } + } + h4 "Samples of isindex" + } + cgi_isindex + cgi_isindex "prompt=Enter some delicious keywords: " + } +} + diff --git a/web/src/cgi.tcl-1.10/example/format-tour.cgi b/web/src/cgi.tcl-1.10/example/format-tour.cgi new file mode 100755 index 00000000..b399279f --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/format-tour.cgi @@ -0,0 +1,101 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows a selection of format elements + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "A Tour of HTML Elements" + cgi_body { + + definition_list { + term "term" + term_definition "definition of term" + } + + h4 "menu list" + menu_list { + li item1 + li item2 + } + + h4 "directory list" + directory_list { + li item1 + li item2 + } + + h4 "a list item by itself" + li "item" + + h4 "number list (roman, starting from 4)" + number_list type=i value=4 { + li "first element" + li "second" + li value=9 "third, start numbering from 9" + li type=A "fourth, switch to upper-arabic" + } + + h4 "bullet list" + bullet_list { + p "plain text" + li "plain item" + h4 "nested list (disc, starting from 4)" + bullet_list type=disc value=4 { + li "first element" + li "second" + li type=circle "third, type=circle" + li type=square "fourth, type=square" + li "fifth, should remain square" + } + } + + h4 "Character formatting samples" + cgi_put "[bold bold]\ + [italic italic]\ + [underline underline]\ + [strikeout strikeout]\ + [subscript subscript]\ + [superscript superscript]\ + [typewriter typewriter]\ + [blink blink] + [emphasis emphasis]\ + [strong strong]\ + [cite cite]\ + [sample sample]\ + [keyboard keyboard]\ + [variable variable]\ + [definition definition]\ + [big big]\ + [small small]\ + [font color=#4499cc "color=#4499cc"]\ + " + for {set i 1} {$i<8} {incr i} { + puts [cgi_font size=$i "size=$i"] + } + + h4 "Paragraph formatting samples" + + cgi_h1 h1 + cgi_h2 h2 + cgi_h3 h3 + cgi_h4 h4 + cgi_h5 h5 + cgi_h6 h6 + cgi_h7 "h7 (beyond the spec, what the heck)" + cgi_h6 align=right "right-aligned h6" + cgi_p align=right "right-aligned paragraph" + cgi_put put + cgi_blockquote "blockquote" + cgi_address address + cgi_division { + puts "division" + } + cgi_preformatted { + puts "preformatted" + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/frame.cgi b/web/src/cgi.tcl-1.10/example/frame.cgi new file mode 100755 index 00000000..f8338b47 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/frame.cgi @@ -0,0 +1,32 @@ +#!/depot/path/tclsh + +# This is a CGI script that creates some frames. + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + cgi_title "Frame example" + + # allow URL's of the form ;# frame.cgi?example=.... + # so as to override default + set example examples ;# default is the examples page itself!! + catch {cgi_import example} + + cgi_frameset rows=100,* { + cgi_frame =$CGITCL + cgi_frameset cols=200,* { + cgi_frame =examples.cgi?framed=yes + cgi_frame script=$example.cgi + } + } + cgi_noframes { + cgi_h1 "uh oh" + + p "This document is designed to be viewed by a Frames-capable + browser. If you see this message your browser is not + Frames-capable." + } +} diff --git a/web/src/cgi.tcl-1.10/example/image.cgi b/web/src/cgi.tcl-1.10/example/image.cgi new file mode 100755 index 00000000..e1321523 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/image.cgi @@ -0,0 +1,29 @@ +#!/depot/path/tclsh +# See description below. + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + describe_in_frame "raw image" "This CGI script generates a raw + image. The script could be much more complicated - the point is + merely to show the framework. (The picture is of the US National + Prototype Kilogram. It is made of 90% platinum, 10% iridium. It + was assigned to the US in 1889 and is periodically recertified and + traceable to [italic "The Kilogram"] held at + [url "Bureau International des Poids et Mesures" http://www.bipm.fr" $TOP] + in France.)" + + # ignore the junk above this line - the crucial stuff is below + + cgi_content_type "image/jpeg" + + set fh [open $DATADIR/kg.jpg r] + fconfigure stdout -translation binary + fconfigure $fh -translation binary + fcopy $fh stdout + close $fh +} + diff --git a/web/src/cgi.tcl-1.10/example/img.cgi b/web/src/cgi.tcl-1.10/example/img.cgi new file mode 100755 index 00000000..4c84787d --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/img.cgi @@ -0,0 +1,39 @@ +#!/depot/path/tclsh + +# This is a CGI script that shows how to do simple images. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Images" + + set NIST_IMAGES http://www.nist.gov/images + + cgi_imglink ball $NIST_IMAGES/ball.gif alt=ball + cgi_imglink birdies $NIST_IMAGES/brd-ln.gif alt=birdies + cgi_imglink daemon $NIST_IMAGES/bsd_daemon.gif "alt=Kirk McKusick's BSD deamon" + + # use white background because some of these images require it + cgi_body bgcolor=#ffffff text=#00b0b0 { + + p "Here are some birdies:[cgi_imglink birdies]" + p "and here is your basic ball [cgi_imglink ball] and here is + the BSD daemon [cgi_imglink daemon]." + + p "I like using the same picture" + p "[cgi_imglink ball] over" + p "[cgi_imglink ball] and over" + p "[cgi_imglink ball] and over" + p "[cgi_imglink ball] so I use the cgi_imglink command to make it easy." + + proc ball {} {return [cgi_imglink ball]} + + p "[cgi_imglink birdies]" + + p "[ball]I can make it even easier [ball] by making a ball + procedure [ball] which I've just done. [ball] You could + tell, eh? [ball]" + } +} diff --git a/web/src/cgi.tcl-1.10/example/kill.cgi b/web/src/cgi.tcl-1.10/example/kill.cgi new file mode 100755 index 00000000..f3ffe6a3 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/kill.cgi @@ -0,0 +1,69 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_title "Kill runaway CGI processes" + + cgi_body { + if {0==[catch {cgi_import PidList}]} { + catch {cgi_import Refresh;set PidList {}} + cgi_import Sig + h4 "If this were not a demo, the following commands would be executed:" + foreach pid $PidList { + # to undemoize this and allow processes to be killed, + # change h5 to exec and remove the quotes + if {[catch {h5 "kill -$Sig $pid"} msg]} { + h4 "$msg" + } + } + } + + cgi_form kill { + set ps /bin/ps + if {[file exists /usr/ucb/ps]} { + set ps /usr/ucb/ps + } + + set f [open "|$ps -auxww" r] + table border=2 { + table_row { + table_data {puts kill} + table_data {cgi_preformatted {puts [gets $f]}} + } + while {-1 != [gets $f buf]} { + if {[regexp "$argv0" $buf]} continue + if {![regexp "^http" $buf]} continue + table_row { + table_data { + scan $buf "%*s %d" pid + cgi_checkbox PidList=$pid + } + table_data { + cgi_preformatted {puts $buf} + } + } + } + + } + + submit_button "=Send signal to selected processes" + submit_button "Refresh=Refresh listing" + reset_button + + br; radio_button "Sig=TERM" checked; puts "SIGTERM: terminate gracefully" + br; radio_button "Sig=KILL"; puts "SIGKILL: terminate ungracefully" + br; radio_button "Sig=STOP"; puts "SIGSTOP: suspend" + br; radio_button "Sig=CONT"; puts "SIGCONT: continue" + + p "SIGSTOP and SIGCONT are particularly useful if the + processes aren't yours and the owner isn't around to ask. + Suspend them and let the owner decide later whether to + continue or kill them." + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/nistguest b/web/src/cgi.tcl-1.10/example/nistguest new file mode 100644 index 00000000..651efc9a --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/nistguest @@ -0,0 +1,102 @@ +Alabama +{} {} x +Alaska +{} {} {} +Arizona +{} {} {} +Arkansas +{} {} x +California +{} {} {} +Colorado +{} {} x +Connecticut +{} {} x +Delaware +{} {} x +Florida +{} {} x +Georgia +{} {} {} +Hawaii +{} {} {} +Idaho +{} {} {} +Illinois +{} {} {} +Indiana +{} {} x +Iowa +{} {} x +Kansas +{} {} {} +Kentucky +{} {} {} +Louisiana +{} {} {} +Maine +{} {} x +Maryland +{} {} x +Massachusetts +{} {} {} +Michigan +{} {} x +Minnesota +{} {} x +Mississippi +{} {} {} +Missouri +{} {} x +Montana +{} {} {} +Nebraska +{} {} x +Nevada +{} {} {} +New Hampshire +{} {} x +New Jersey +{} {} x +New Mexico +{} {} {} +New York +{} {} x +North Carolina +{} {} x +North Dakota +{} {} {} +Ohio +{} {} {} +Oklahoma +{} {} x +Oregon +{} {} {} +Pennsylvania +{} {} {} +Rhode Island +{} {} {} +South Carolina +{} {} x +South Dakota +{} {} x +Tennessee +{} {} x +Texas +{} {} x +Utah +{} {} x +Vermont +{} {} {} +Virginia +{} {} x +Washington +{} {} x +Washington DC +{} {} {} +West Virginia +{} {} {} +Wisconsin +{} {} x +Wyoming +{} {} {} diff --git a/web/src/cgi.tcl-1.10/example/nistguest.cgi b/web/src/cgi.tcl-1.10/example/nistguest.cgi new file mode 100755 index 00000000..b41d456b --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/nistguest.cgi @@ -0,0 +1,130 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + cgi_title "NIST Guest Book" + + cgi_uid_check http + + set BarURL $EXPECT_ART/pink.gif + + set Q(filename) "$DATADIR/nistguest" + + set statesNeeded {} + + proc poll_read {} { + global Q + + set fid [open $Q(filename) r] + while {-1!=[gets $fid StateFullName]} { + regsub " " $StateFullName "" State + set Q($State) $StateFullName + gets $fid buf + foreach "Q($State,1) Q($State,2) Q($State,3)" $buf {} + lappend Q(statesAll) $State + if {0 == [string compare "" "$Q($State,3)"]} { + lappend Q(statesNeeded) $State + } + } + close $fid + } + + proc poll_write {} { + global Q + + # No file locking or real database handy so we can't guarantee that + # simultaneous votes aren't dropped, but we'll at least avoid + # corruption of the file by working on a private copy. + set tmpfile $Q(filename).[pid] + set fid [open $tmpfile w] + foreach state $Q(statesAll) { + set data [list $Q($state,1) $Q($state,2) $Q($state,3)] + puts $fid $Q($state)\n$data + } + close $fid + exec mv $tmpfile $Q(filename) + } + + cgi_body { + poll_read + + if {0 == [catch {cgi_import State}]} { + if {![info exists Q($State)]} { + user_error "There is no such state: $State" + } + + set Name "" + catch {import Name} + if {0==[string length $Name]} { + user_error "You didn't provide your name." + } + + set Email "" + catch {import Email} + + set Description "" + catch {import Description} + if {0==[string length $Description]} { + user_error "You didn't provide a description." + } + + set data "<Name $Name><Email $Email><Description $Description>" + # simplify poll_read by making each entry a single line + regsub -all \n $data " " data + + if {0 == [string compare "" $Q($State,1)]} { + set Q($State,1) $data + } elseif {0 == [string compare "" $Q($State,2)]} { + set Q($State,2) $data + } else { + set Q($State,3) $data + } + + poll_write + puts "Thanks for your submission!" + + return + } + + form nistguest { + puts "In the spirit of Scriptics' request for Tcl success +stories, our group at NIST is looking for some too. It's time for our +annual report to Congress. So if your state appears in the list below +and you can provide a brief description of how our work has helped +you, we would appreciate hearing from you." + hr + br;puts "If your state does not appear in this list, then we +already have enough entries for your state. Thanks anyway!" + br;puts "State:" + cgi_select State { + foreach state $Q(statesNeeded) { + option "$Q($state)" value=$state + } + } + + br;puts "Full name:" + cgi_text Name= + + br;puts "We probably won't need to contact you; But just in +case, please provide some means of doing so. Email info will remain +confidential - you will NOT be put on any mailing lists." + br;puts "Email:" + cgi_text Email= + puts "(optional)" + + p "Please describe a significant impact (e.g., goals +accomplished, hours/money saved, user expectations met or exceeded) +that NIST's Tcl-based work (Expect, cgi.tcl, APDE, APIB, EXPRESS +server, ...) has had on your organization. A brief paragraph is +fine." + + cgi_textarea Description= rows=10 cols=80 + br + submit_button "=Submit" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/oratcl.cgi b/web/src/cgi.tcl-1.10/example/oratcl.cgi new file mode 100644 index 00000000..de4a7626 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/oratcl.cgi @@ -0,0 +1,33 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates how easy it is to use a web +# page to query an Oracle server - using cgi.tcl and Oratcl. +# This example fetches the date from Oracle. + +# I wish we had a public account on our Oracle server so that I could +# allow anyone to run this, but alas we don't. So you'll have to +# trust me that it works. - Don + +package require cgi +package require Oratcl + +cgi_eval { + source example.tcl + + cgi_title "Oracle Example" + cgi_input + + cgi_body { + set env(ORACLE_SID) fork + set env(ORACLE_HOME) /u01/oracle/product/7322 + + set logon [oralogon [import user] [import password]] + set cursor [oraopen $logon] + + orasql $cursor "select SysDate from Dual" + h4 "Oracle's date is [orafetch $cursor]" + + oraclose $cursor + oralogoff $logon + } +} diff --git a/web/src/cgi.tcl-1.10/example/parray.cgi b/web/src/cgi.tcl-1.10/example/parray.cgi new file mode 100755 index 00000000..a4c23316 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/parray.cgi @@ -0,0 +1,48 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays the environment or another array. + +package require cgi + +cgi_eval { + source example.tcl + + proc arrays {} { + uplevel #0 { + set buf {} + foreach a [info globals] { + if {[array exists $a]} { + lappend buf $a + } + } + return $buf + } + } + + cgi_input + + cgi_title "Display environment or another array" + + cgi_body { + p "This script displays the environment or another array." + if {[catch {cgi_import Name}]} { + set Name env + } + + cgi_form parray { + cgi_select Name { + foreach a [arrays] { + cgi_option $a selected_if_equal=$Name + } + } + cgi_submit_button + } + + global $Name + if {[array exist $Name]} { + cgi_parray $Name + } else { + puts "$Name: no such array" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/passwd-form.cgi b/web/src/cgi.tcl-1.10/example/passwd-form.cgi new file mode 100755 index 00000000..9d99b716 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/passwd-form.cgi @@ -0,0 +1,39 @@ +#!/depot/path/tclsh + +# This is a CGI script to present a form in which to change a password. + +# This form doesn't actually have to be written as a CGI script, +# however, it is done so here to demonstrate the procedures described +# in the Tcl '96 paper by Don Libes. You can find this same form +# written as static html in the example directory of the Expect +# package. + +package require cgi + +cgi_eval { + source example.tcl + source passwd.tcl + + cgi_input + + # Use a cookie so that if user has already entered name, don't make them + # do it again. If you dislike cookies, simply remove the next two + # lines - cookie use here is simply a convenience for users. + set login "" + catch {cgi_import_cookie login} + + cgi_title "Change your login password" + cgi_body { + cgi_form passwd { + put "Username: "; cgi_text login size=16 + password "Old" old + password "New" new1 + password "New" new2 + + p "(The new password must be entered twice to avoid typos.)" + + cgi_submit_button "=Change password" + cgi_reset_button + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/passwd.cgi b/web/src/cgi.tcl-1.10/example/passwd.cgi new file mode 100755 index 00000000..85c18174 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/passwd.cgi @@ -0,0 +1,119 @@ +#!/depot/path/expect -- + +# This is a CGI script to process requests created by the accompanying +# passwd.html form. This script is pretty basic, although it is +# reasonably robust. (Purposely intent users can make the script bomb +# by mocking up their own HTML form, however they can't expose or steal +# passwords or otherwise open any security holes.) This script doesn't +# need any special permissions or ownership. +# +# With a little more code, the script can do much more exotic things - +# for example, you could have the script: +# +# - telnet to another host first (useful if you run CGI scripts on a +# firewall), or +# +# - change passwords on multiple password server hosts, or +# +# - verify that passwords aren't in the dictionary, or +# +# - verify that passwords are at least 8 chars long and have at least 2 +# digits, 2 uppercase, 2 lowercase, or whatever restrictions you like, +# or +# +# - allow short passwords by responding appropriately to passwd +# +# and so on. Have fun! +# +# Don Libes, NIST + +package require cgi + +cgi_eval { + source example.tcl + source passwd.tcl + + cgi_input + + # Save username as cookie (see comment in passwd-form script) so that the + # next time users load the form, their username will already be filled in. + # If cookies bother you, simply remove this entire cgi_http_head command. + cgi_http_head { + cgi_content_type text/html + if {0==[catch {cgi_import login}]} { + cgi_export_cookie login expires=never + } + } + + cgi_title "Password Change Acknowledgment" + cgi_body { + if {(![info exists login]) + || [catch {cgi_import old}] + || [catch {cgi_import new1}] + || [catch {cgi_import new2}]} { + errormsg "This page has been called with input missing. Please \ + visit this form by filling out the password change \ + request form." + return + } + + # Prevent user from sneaking in commands (albeit under their own uid). + if {[regexp "\[^a-zA-Z0-9]" $login char]} { + errormsg "Illegal character ($char) in username." + return + } + + log_user 0 + + # Need to su first to get around passwd's requirement that + # passwd cannot be run by a totally unrelated user. Seems + # rather pointless since it's so easy to satisfy, eh? + + # Change following line appropriately for your site. + # (We use yppasswd, but you might use something else.) + spawn /bin/su $login -c "/bin/yppasswd $login" + # This fails on SunOS 4.1.3 (passwd says "you don't have a + # login name") so run on (or telnet first to) host running + # SunOS 4.1.4 or later. + + expect { + -re "Unknown (login|id):" { + errormsg "unknown user: $login" + return + } default { + errormsg "$expect_out(buffer)" + return + } "Password:" + } + send "$old\r" + expect { + "unknown user" { + errormsg "unknown user: $login" + return + } "Sorry" { + errormsg "Old password incorrect" + return + } default { + errormsg "$expect_out(buffer)" + return + } "Old password:" + } + send "$old\r" + expect "New password:" + send "$new1\r" + expect "New password:" + send "$new2\r" + expect -re (.+)\r\n { + set error $expect_out(1,string) + } + close + wait + + if {[info exists error]} { + errormsg "$error" + } else { + successmsg "Password changed successfully." + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/passwd.tcl b/web/src/cgi.tcl-1.10/example/passwd.tcl new file mode 100644 index 00000000..31de1e17 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/passwd.tcl @@ -0,0 +1,10 @@ +# common definitions for all password-related pages + +proc password {prompt varname} { + br + put "$prompt password: " + cgi_text $varname= type=password size=16 +} + +proc successmsg {s} {h3 "$s"} +proc errormsg {s} {h3 "Error: $s"} diff --git a/web/src/cgi.tcl-1.10/example/push.cgi b/web/src/cgi.tcl-1.10/example/push.cgi new file mode 100755 index 00000000..75aeb98c --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/push.cgi @@ -0,0 +1,37 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + set boundary "ThisRandomString" + + cgi_http_head { + cgi_content_type "multipart/x-mixed-replace;boundary=$boundary" + + puts \n--$boundary + cgi_content_type + } + + cgi_title "Multipart example - 1st page" + cgi_body { + h4 "This is an example of [italic server-push] as implemented + by the multipart MIME type. In contrast with client-pull, push + leaves the connection open and the CGI script remains in control + as to send more information. The additional information can + be anything - this example demonstrates an entire page being + replaced." + } + + puts \n--$boundary + after 5000 + + cgi_content_type + + cgi_title "Multipart example - 2nd page" + cgi_body { + h4 "This page replaced the previous page with no action on the + client side." + } +} diff --git a/web/src/cgi.tcl-1.10/example/rm.cgi b/web/src/cgi.tcl-1.10/example/rm.cgi new file mode 100644 index 00000000..bc9534af --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/rm.cgi @@ -0,0 +1,59 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_title "Remove old CGI files from /tmp" + + cgi_body { + if {0==[catch {cgi_import FileList}]} { + catch {cgi_import Refresh;set FileList {}} + h4 "If this were not a demo, the following commands would have been executed:" + foreach File $FileList { + # prevent deletion of this dir or anything outside it + set File [file tail $File] + switch $File . - .. - "" { + h3 "Illegal filename: $File" + continue + } + + # to undemoize this and allow files to be killed, + # remove h5 and quotes + if {[catch {h5 "file delete -force /tmp/$File"} msg]} { + h4 "$msg" + } + } + } + + cgi_form rm { + set f [open "|/bin/ls -Alt /tmp" r] + table border=2 { + table_row { + table_data {puts "rm -rf"} + table_data {cgi_preformatted {puts "permissions ln owner group size date filename"}} + } + while {-1 != [gets $f buf]} { + if {![regexp " http " $buf]} continue + table_row { + table_data { + regexp ".* (\[^ ]+)$" $buf dummy File + cgi_checkbox FileList=$File + } + table_data { + cgi_preformatted {puts $buf} + } + } + } + + } + + submit_button "=Removed selected files" + submit_button "Refresh=Refresh listing" + reset_button + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/stopwatch.cgi b/web/src/cgi.tcl-1.10/example/stopwatch.cgi new file mode 100755 index 00000000..4fb4f8c3 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/stopwatch.cgi @@ -0,0 +1,64 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates a simple Tcl applet + +package require cgi + +source example.tcl + +set srcdir http://www.nist.gov/mel/div826/src/stopwatch +set plugins http://www.sunlabs.com/research/tcl/plugin + +cgi_link source "source" $srcdir/stopwatch.tcl.html" +cgi_link gz "complete distribution" $srcdir/stopwatch.tar.gz +cgi_link moreplugins "More info on Tcl plugins" $plugins +cgi_link homepage "homepage" $EXPECT_HOST/stopwatch + +cgi_eval { + + cgi_input + + cgi_head { + cgi_title "Stopwatch implemented via Tcl applet" + } + cgi_body { + h3 "Description" + + p "This tclet provides a stopwatch. I wrote it to help me + time talks and individual slides within a talk. Stopwatch can + also be run as a Tk script outside the browser - which is the + way I normally use it. If you want to use it outside the browser, grab the distribution from the stopwatch [cgi_link homepage]." + + h3 "Directions" + + p {Press "start" to start the stopwatch and "stop" to stop it. + "zero" resets the time. You can also edit/cut/paste the time + by hand and set it to any valid time. A second timer is + provided as well. It works just like a normal lap timer.} + + cgi_embed http://www.nist.gov/mel/div826/src/stopwatch/stopwatch.tcl \ + 450x105 + + p "This is the first Tclet I've ever written. Actually, I + just took an existing Tk script I had already written and + wrapped it in an HTML page. It took about 30 minutes to write + the original Tk script (about 80 lines) and 1 minute to embed + it in an HTML page." + + p "Stopwatch is not intended for timing less than one second + or longer than 99 hours. It's easy to make make it show more + but the code doesn't do it as distributed and I have no + interest in adding more and more features until it reads mail. + It's just a nice, convenient stopwatch." + + h3 "For more info" + + cgi_bullet_list { + cgi_li "Stopwatch [cgi_link homepage]." + cgi_li "Stopwatch [cgi_link source] and [cgi_link gz]." + cgi_li "[cgi_link moreplugins]." + } + } +} + + diff --git a/web/src/cgi.tcl-1.10/example/unimail.cgi b/web/src/cgi.tcl-1.10/example/unimail.cgi new file mode 100755 index 00000000..9fca7cb0 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/unimail.cgi @@ -0,0 +1,58 @@ +#!/depot/path/tclsh + +# This script is a universal mail backend. It's handy for creating +# forms that simply email all their elements to someone else. You +# wouldn't use it in a fancy application, but non-programmers like it +# since they can use it to process forms with no CGI scripting at all. +# +# To use, make your form look something like this: +# +# <form action="http://ats.nist.gov/cgi-bin/cgi.tcl/unimail.cgi" method=post> +# <input type=hidden name=mailto value="YOUR EMAIL ADDRESS HERE"> +# ...rest of your form... +# </form> +# +# Note: You can use our action URL to try this out, but please switch +# to using your own local unimail script for production use. Thanks! +# +# Author: Don Libes, NIST + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Universal mail backend" + + cgi_body { + if {[catch cgi_input errormsg]} { + h2 "Form Error" + p "An error was detected in the form. Please send the + following diagnostics to the form author." + cgi_preformatted {puts $errormsg} + return + } + if {[catch {cgi_import mailto}]} { + h2 "Error: No mailto variable in form." + return + } + if {![info exists env(HTTP_REFERER)]} { + set env(HTTP_REFERER) "unknown" + } + cgi_mail_start $mailto + cgi_mail_add "Subject: submission from web form: $env(HTTP_REFERER)" + cgi_mail_add + catch {cgi_mail_add "Remote addr: $env(REMOTE_ADDR)"} + catch {cgi_mail_add "Remote host: $env(REMOTE_HOST)"} + + foreach item [cgi_import_list] { + cgi_mail_add "$item: [cgi_import $item]" + } + cgi_mail_end + + if {[catch {cgi_import thanks}]} { + set thanks [cgi_buffer {h2 "Thanks for your submission."}] + } + cgi_put $thanks + } +} diff --git a/web/src/cgi.tcl-1.10/example/upload.cgi b/web/src/cgi.tcl-1.10/example/upload.cgi new file mode 100755 index 00000000..9841aa97 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/upload.cgi @@ -0,0 +1,59 @@ +#!/depot/path/tclsh + +# This is a CGI script that demonstrates file uploading. + +package require cgi + +cgi_eval { + source example.tcl + + proc showfile {v} { + catch { + set server [cgi_import_file -server $v] + set client [cgi_import_file -client $v] + set type [cgi_import_file -type $v] + if {[string length $client]} { + h4 "Uploaded: $client" + if {0 != [string compare $type ""]} { + h4 "Content-type: $type" + } + cgi_import showList + foreach show $showList { + switch $show { + "od -c" - "cat" { + h5 "Contents shown using $show" + cgi_preformatted {puts [eval exec $show [list $server]]} + } + } + } + } + exec /bin/rm -f $server + } + } + + cgi_input + + cgi_head { + cgi_title "File upload demo" + } + cgi_body { + if {[info tcl] < 8.1} { + h4 "Warning: This script can not perform binary uploads because the server is running a pre-8.1 Tcl ([info tcl])." + } + + showfile file1 + showfile file2 + + cgi_form upload enctype=multipart/form-data { + p "Select up to two files to upload" + cgi_file_button file1; br + cgi_file_button file2; br + checkbox "showList=cat" checked; + put "show contents using cat" ;br + checkbox "showList=od -c" + put "show contents using od -c" ;br + cgi_submit_button =Upload + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/utf.cgi b/web/src/cgi.tcl-1.10/example/utf.cgi new file mode 100644 index 00000000..1a5a1243 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/utf.cgi @@ -0,0 +1,17 @@ +#!/local/bin/tclsh + +# Test UTF encoding + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Study utf encoding" + cgi_html { + cgi_body { + p "I'm going to be living on the Straüße." + } + } +} + diff --git a/web/src/cgi.tcl-1.10/example/validate.cgi b/web/src/cgi.tcl-1.10/example/validate.cgi new file mode 100755 index 00000000..c104b7b5 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/validate.cgi @@ -0,0 +1,76 @@ +#!/depot/path/tclsh + +# This CGI script uses JavaScript to validate a form before submission. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + cgi_head { + title "Using JavaScript to validate a form before submission" + + javascript { + puts { + function odd(num) { + if (num.value % 2 == 0) { + alert("Please enter an odd number!") + num.value = "" + return false + } + return true + } + } + } + noscript { + puts "Sorry - your browser doesn't understand JavaScript." + } + } + + set rownum 0 + proc row {msg {event {}}} { + global rownum + + incr rownum + table_row { + table_data nowrap { + put "Odd number: " + text num$rownum= size=4 $event + } + table_data { + puts $msg + } + } + } + + cgi_body { + set more "" + if {0 == [catch {import num3}]} { + set count [scan $num3 %d num] + if {($count != 1) || ($num % 2 == 0)} { + p "Hey, you didn't enter an odd number!" + } else { + p "Thanks for entering odd numbers!" + set more " more" + } + } + + puts "Please enter$more odd numbers - thanks!" + + cgi_form validate "onSubmit=return odd(this.num2)" { + table { + row "This number will be validated when it is entered." onChange=odd(this.form.num1) + row "This number will be validated when the form is submitted." + row "This number will be validated after the form is submitted." + } + submit_button =Submit + } + + h5 "Note: JavaScript validation should always be accompanied + by validation in the backend (CGI script) since browsers + cannot be relied upon to have JavaScript enabled (or supported + in the first place). Sigh." + } +} diff --git a/web/src/cgi.tcl-1.10/example/vclock-src-frame.cgi b/web/src/cgi.tcl-1.10/example/vclock-src-frame.cgi new file mode 100755 index 00000000..37cd6d4b --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vclock-src-frame.cgi @@ -0,0 +1,23 @@ +#!/depot/path/tclsh + +# This CGI script displays the Tcl and Perl vclock source side by side. + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Comparison of vclock source" + + cgi_frameset cols=50%,* { + cgi_frame =[cgi_cgi display scriptname=vclock.cgi] + cgi_frame =[cgi_cgi display scriptname=vclock.pl] + } + cgi_noframes { + cgi_h1 "uh oh" + + p "This document is designed to be viewed by a Frames-capable + browser. If you see this message your browser is not + Frames-capable." + } +} diff --git a/web/src/cgi.tcl-1.10/example/vclock.cgi b/web/src/cgi.tcl-1.10/example/vclock.cgi new file mode 100755 index 00000000..4b925b9f --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vclock.cgi @@ -0,0 +1,73 @@ +#!/depot/path/tclsh + +# This script implements the "Virtual Clock" used as the example in the +# paper describing CGI.pm, a perl module for generating CGI. +# Stein, L., "CGI.pm: A Perl Module for Creating Dynamic HTML Documents +# with CGI Scripts", SANS 96, May '96. + +# Do you think it is more readable than the other version? +# (If you remove the comments and blank lines, it's exactly +# the same number of lines.) See other comments after script. - Don + +package require cgi + +cgi_eval { + source example.tcl + + cgi_input + + set format "" + if {[llength [cgi_import_list]]} { + if 0==[catch {cgi_import time}] { + append format [expr {[cgi_import type] == "12-hour"?"%r ":"%T "}] + } + catch {cgi_import day; append format "%A "} + catch {cgi_import month; append format "%B "} + catch {cgi_import day-of-month; append format "%d "} + catch {cgi_import year; append format "%Y "} + } else { + append format "%r %A %B %d %Y" + } + + set time [clock format [clock seconds] -format $format] + + cgi_title "Virtual Clock" + + cgi_body { + puts "At the tone, the time will be [strong $time]" + hr + h2 "Set Clock Format" + + cgi_form vclock { + puts "Show: " + foreach x {time day month day-of-month year} { + cgi_checkbox $x checked + put $x + } + br + puts "Time style: " + cgi_radio_button type=12-hour checked;put "12-hour" + cgi_radio_button type=24-hour ;put "24-hour" + br + cgi_reset_button + cgi_submit_button =Set + } + } +} + +# Notes: + +# Time/date generation is built-in to Tcl. Thus, no extra processes +# are necessary and the result is portable. In contrast, CGI.pm +# only runs on UNIX. + +# Displaying checkboxes side by side the way that CGI.pm does by +# default is awful. The problem is that with enough buttons, it's not +# immediately clear if the button goes with the label on the right or +# left. So cgi.tcl does not supply a proc to generate such a +# grouping. I've followed CGI.pm's style here only to show that it's +# trivial to get the same affect, but the formatting in any real form +# is more wisely left to the user. + +# Footer generation (<hr><address>... at end of CGI.pm) is replaced +# by "source example.tcl". Both take one line. diff --git a/web/src/cgi.tcl-1.10/example/vclock.pl b/web/src/cgi.tcl-1.10/example/vclock.pl new file mode 100644 index 00000000..0605f0c7 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vclock.pl @@ -0,0 +1,59 @@ +#!/usr/local/bin/perl + +# This script is the "Virtual Clock" example in the seminal +# paper describing CGI.pm, a perl module for generating CGI. +# Stein, L., "CGI.pm: A Perl Module for Creating Dynamic HTML Documents +# with CGI Scripts", SANS 96, May '96. + +# Do you think it is more readable than the other version? +# (If you remove the comments and blank lines, it's exactly +# the same number of lines.) - Don + +use CGI; +$q = new CGI; + +if ($q->param) { + if ($q->param('time')) { + $format = ($q->param('type') eq '12-hour') ? '%r ' : '%T'; + } + + $format .= '%A ' if $q->param('day'); + $format .= '%B ' if $q->param('month'); + $format .= '%d ' if $q->param('day-of-month'); + $format .= '%Y ' if $q->param('year'); +} else { + $format = '%r %A %B %d %Y'; +} + +$time = `date '+$format'`; + +# print the HTTP header and the HTML document +print $q->header; +print $q->start_html('Virtual Clock'); +print <<END; +<H1>Virtual Clock</H1> +At the tone, the time will be <STRONG>$time</STRONG>. +END + +print <<END; +<HR> +<H2>Set Clock Format</H2> +END + +# Create the clock settings form +print $q->start_form; +print "Show: "; +print $q->checkbox(-name->'time',-checked=>1); +print $q->checkbox(-name->'day',-checked=>1); +print $q->checkbox(-name->'month',-checked=>1); +print $q->checkbox(-name->'day-of-month',-checked=>1); +print $q->checkbox(-name->'year',-checked=>1); +print "<P>Time style:"; +print $q->radio_group(-name=>'type', + -values=>['12-hour','24-hour']),"<P>"; +print $q->reset(-name=>'Reset'), + $q->submit(-name=>'Set'); +print $q->end_form; + +print '<HR><ADDRESS>webmaster@ferrets.com</ADDRESS>' +print $q->end_html; diff --git a/web/src/cgi.tcl-1.10/example/version.cgi b/web/src/cgi.tcl-1.10/example/version.cgi new file mode 100644 index 00000000..b266acfb --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/version.cgi @@ -0,0 +1,30 @@ +#!/depot/path/tclsh + +# This is a CGI script that displays some version information that I +# find useful for debugging. + +set v [package require cgi] + +proc row {var val} { + table_row { + td $var + td $val + } +} + +cgi_eval { + source example.tcl + + title "Version info" + + cgi_body { + table border=2 { + row "cgi.tcl" $v + row "Tcl" [info patchlevel] + row "uname -a" [exec uname -a] + catch {row "SERVER_SOFTWARE" $env(SERVER_SOFTWARE)} + catch {row "HTTP_USER_AGENT" $env(HTTP_USER_AGENT)} + catch {row "SERVER_PROTOCOL" $env(SERVER_PROTOCOL)} + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/visitor.cgi b/web/src/cgi.tcl-1.10/example/visitor.cgi new file mode 100755 index 00000000..ee73922e --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/visitor.cgi @@ -0,0 +1,30 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + + cgi_title "Visitor count example" + + cgi_body { + cgi_put "This page demonstrates how easy it is to do visitor counts." + + cgi_uid_check http + + cgi_form visitor { + set cfname "$DATADIR/visitor.cnt" + + if {[catch {set fid [open $cfname r+]} errormsg]} { + h4 "Couldn't open $cfname to maintain visitor count: $errormsg" + return + } + gets $fid count + seek $fid 0 start + puts $fid [incr count] + close $fid + h4 "You are visitor $count. Revisit soon!" + cgi_submit_button "=Revisit" + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/visitor.cnt b/web/src/cgi.tcl-1.10/example/visitor.cnt new file mode 100755 index 00000000..5595fa46 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/visitor.cnt @@ -0,0 +1 @@ +95 diff --git a/web/src/cgi.tcl-1.10/example/vote.cgi b/web/src/cgi.tcl-1.10/example/vote.cgi new file mode 100755 index 00000000..6d06b977 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vote.cgi @@ -0,0 +1,190 @@ +#!/depot/path/tclsh + +package require cgi + +cgi_eval { + source example.tcl + cgi_input + + cgi_title "Vote for a t-shirt design!" + + cgi_uid_check http + + set BarURL $EXPECT_ART/pink.gif + + set Q(filename) "$DATADIR/vote.cnt" + + proc votes_read {} { + global Q + + set Q(Max) 0 + set Q(Votes) 0 + set Q(Indices) "" + + set fid [open $Q(filename) r] + while {-1!=[gets $fid i]} { + gets $fid buf + foreach "Q(Votes,$i) Q(Entry,$i) Q(Name,$i) Q(Email,$i)" $buf {} + lappend Q(Indices) $i + set Q(Unvotable,$i) [catch {incr Q(Votes) $Q(Votes,$i)}] + set Q(Max) $i + } + close $fid + } + + proc votes_write {} { + global Q + + # No file locking (or real database) handy so we can't guarantee that + # simultaneous votes aren't dropped, but we'll at least avoid + # corruption of the vote file by working on a private copy. + set tmpfile $Q(filename).[pid] + set fid [open $tmpfile w] + foreach i $Q(Indices) { + set data [list $Q(Votes,$i) $Q(Entry,$i) $Q(Name,$i) $Q(Email,$i)] + # simplify votes_read by making each entry a single line + regsub -all \n $data <br> data + puts $fid $i\n$data + } + close $fid + exec mv $tmpfile $Q(filename) + } + + proc vote_other_show {} { + global Q + + h3 "Other suggestions" + table border=2 { + table_row { + th width=300 "Entry" + th width=300 "Judge's Comments" + } + foreach i $Q(Indices) { + if {!$Q(Unvotable,$i)} continue + table_row { + td width=300 "$Q(Entry,$i)" + td width=300 "$Q(Votes,$i)" + } + } + } + } + + + cgi_body { + votes_read + + if {[regexp "Vote(\[0-9]+)" [cgi_import_list] dummy i]} { + if {[catch {incr Q(Votes,$i)}]} { + user_error "There is no such entry to vote for." + } + incr Q(Votes) + votes_write + + h3 "Thanks for voting! See you at the next Tcl conference!" + set ShowVotes 1 + } + catch {cgi_import ShowVotes} + if {[info exists ShowVotes]} { + table border=2 { + table_row { + th width=300 "Entry" + th "Votes" + th width=140 "Percent" ;# 100 + room for pct + } + foreach i $Q(Indices) { + if {!$Q(Unvotable,$i)} { + table_row { + td width=300 "$Q(Entry,$i)" + td align=right "$Q(Votes,$i)" + table_data width=140 { + table { + table_row { + set pct [expr 100*$Q(Votes,$i)/$Q(Votes)] + # avoid 0-width Netscape bug + set pct_bar [expr $pct==0?1:$pct] + td [img $BarURL align=left width=$pct_bar height=15] + td $pct + } + } + } + } + } + } + } + form vote { + submit_button "=Submit entry or vote" + submit_button "ShowVotes=Show votes" + } + vote_other_show + return + } + + if 0==[catch {import Entry}] { + if {[string length $Entry] == 0} { + user_error "No entry found." + } + if {[string length $Entry] > 500} { + user_error "Your entry is too long. Keep it under 500 characters!" + } + set Name "" + catch {import Name} + if 0==[string length $Name] { + user_error "You must supply your name. How are we going to know who you are if you win?" + } + set Email "" + catch {import Email} + if 0==[string length $Email] { + user_error "You must supply your email. How are we going to contact you if you win?" + } + + set i [incr Q(Max)] + set Q(Entry,$i) $Entry + set Q(Name,$i) $Name + set Q(Email,$i) $Email + set Q(Votes,$i) 1 + lappend Q(Indices) $i + + votes_write + + h3 "Thanks for your new entry!" + p "No need to go back and vote for it - a vote has already + been recorded for you." + form vote { + submit_button "=Submit another entry or vote" + submit_button "ShowVotes=Show votes" + } + return + } + + p "Vote for what will go on the next Tcl conference t-shirt! (Feel free to vote for several entries.)" + + cgi_form vote { + table border=2 { + foreach i $Q(Indices) { + if {$Q(Unvotable,$i)} continue + table_row { + table_data { + cgi_submit_button Vote$i=Vote + } + td "$Q(Entry,$i)" + } + } + } + br + cgi_submit_button "ShowVotes=Just show me the votes" + hr + p "The author of the winning entry gets fame and glory (and a free t-shirt)! Submit a new entry:" + cgi_text Entry= size=80 + p "Entries may use embedded HTML. Images or concepts are fine - for artwork, we have the same artist who did the [url "'96 conference shirt" $MSID_STAFF/libes/t.html]). The [url judges mailto:tclchairs@usenix.org] reserve the right to delete entries. (Do us a favor and use common sense and good taste!)" + puts "Name: " + cgi_text Name= + br + puts "Email: " + cgi_text Email= + br + cgi_submit_button "=Submit new entry" + + vote_other_show + } + } +} diff --git a/web/src/cgi.tcl-1.10/example/vote.cnt b/web/src/cgi.tcl-1.10/example/vote.cnt new file mode 100644 index 00000000..73bc9061 --- /dev/null +++ b/web/src/cgi.tcl-1.10/example/vote.cnt @@ -0,0 +1,30 @@ +1 +179 {Tcl/Tk: The best-kept secret in the software industry} {Michael McLennan} mmc +2 +{it's got potential, needs more work} {Tcl/Tk: Saving the world one proc at a time} {Michael McLennan} mmc +3 +24 {Tcl/Tk: Programmers by day, heros by the end of the quarter} {Michael McLennan} mmc +4 +39 {Tcl/Tk: The struggle between good and eval} {Michael McLennan} mmc +6 +{already dated} {I love Tcl...but <i>puleeez</i> don't call me Elmo!} {mark pernal} mpernal@sprintmail.com +7 +{surely we have more imagination?} spec-TCL-ular {Joerg Reiberg} reiberg@uni-muenster.de +8 +48 {Tcl/Tk: Less Code, More Results} {Bob Jackson} jackson@stsci.edu +9 +{committed alright} {True Committed Lover} {Stephan Uyttebroeck} stephan@frontierd.com +12 +{may we suggest you invest five minutes reading the manual...} {Tcl/Tk: Welcome to string quoting hell!} {Harry Bovik} bovik+junk@cs.cmu.edu +13 +{We'll make up a special one-of-a-kind t-shirt for you, ok?} {I'd rather be hacking Perl.} psu psu@jprc.com +15 +{has potential but needs more work} {Tcl/Tk: A Rabid Prototyping Language} {Ralph Melton} ralph@cs.cmu.edu +16 +{the important thing is, you were using it!} {Tcl/Tk: If at first you don't succeed, you must have been using it} {Dushyanth Narayanan} bumba=roc_tcltk@cs.cmu.edu +17 +{the Howard Stern / People Magazine version} {perl: the angry drunken scripting language} {John Prevost} visigoth+www@cs.cmu.edu +18 +{already taken by Perl, shucks} {Perl: a fast and powerful tool for creating completely inconsistent, incoherent, and unmaintainable code.} {Don} don@libes.com +19 +{ok, enough Perl bashing!} {Perl: an awesome collection of special cases, side-effects, neato punctuation, and enough ambiguity to make a Ouija board blush.} {Don} don@libes.com diff --git a/web/src/cgi.tcl-1.10/fixline1 b/web/src/cgi.tcl-1.10/fixline1 new file mode 100755 index 00000000..1cb57972 --- /dev/null +++ b/web/src/cgi.tcl-1.10/fixline1 @@ -0,0 +1,13 @@ +#!/depot/path/expect -- +# Synopsis: fixline1 newpath < input > output +# Author: Don Libes + +# Description: change first line of script to reflect new binary +# try to match any of the following first lines +#!expect ... +#!../expect ... +#!expectk ... +#!foo/bar/expectk ... +# +regsub "^#!(.*/)*(.*)" [gets stdin] "#!$argv/\\2" line1 +puts -nonewline "$line1\n[read stdin]" diff --git a/web/src/cgi.tcl-1.10/install-sh b/web/src/cgi.tcl-1.10/install-sh new file mode 100755 index 00000000..89fc9b09 --- /dev/null +++ b/web/src/cgi.tcl-1.10/install-sh @@ -0,0 +1,238 @@ +#! /bin/sh +# +# install - install a program, script, or datafile +# This comes from X11R5. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. +# + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" +mkdirprog="${MKDIRPROG-mkdir}" + +tranformbasename="" +transform_arg="" +instcmd="$mvprog" +chmodcmd="$chmodprog 0755" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" +dir_arg="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -d) dir_arg=true + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + -t=*) transformarg=`echo $1 | sed 's/-t=//'` + shift + continue;; + + -b=*) transformbasename=`echo $1 | sed 's/-b=//'` + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + # this colon is to work around a 386BSD /bin/sh bug + : + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +else + true +fi + +if [ x"$dir_arg" != x ]; then + dst=$src + src="" + + if [ -d $dst ]; then + instcmd=: + else + instcmd=mkdir + fi +else + +# Waiting for this to be detected by the "$instcmd $src $dsttmp" command +# might cause directories to be created, which would be especially bad +# if $src (and thus $dsttmp) contains '*'. + + if [ -f $src -o -d $src ] + then + true + else + echo "install: $src does not exist" + exit 1 + fi + + if [ x"$dst" = x ] + then + echo "install: no destination specified" + exit 1 + else + true + fi + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + + if [ -d $dst ] + then + dst="$dst"/`basename $src` + else + true + fi +fi + +## this sed command emulates the dirname command +dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` + +# Make sure that the destination directory exists. +# this part is taken from Noah Friedman's mkinstalldirs script + +# Skip lots of stat calls in the usual case. +if [ ! -d "$dstdir" ]; then +defaultIFS=' +' +IFS="${IFS-${defaultIFS}}" + +oIFS="${IFS}" +# Some sh's can't handle IFS=/ for some reason. +IFS='%' +set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` +IFS="${oIFS}" + +pathcomp='' + +while [ $# -ne 0 ] ; do + pathcomp="${pathcomp}${1}" + shift + + if [ ! -d "${pathcomp}" ] ; + then + $mkdirprog "${pathcomp}" + else + true + fi + + pathcomp="${pathcomp}/" +done +fi + +if [ x"$dir_arg" != x ] +then + $doit $instcmd $dst && + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi +else + +# If we're going to rename the final executable, determine the name now. + + if [ x"$transformarg" = x ] + then + dstfile=`basename $dst` + else + dstfile=`basename $dst $transformbasename | + sed $transformarg`$transformbasename + fi + +# don't allow the sed command to completely eliminate the filename + + if [ x"$dstfile" = x ] + then + dstfile=`basename $dst` + else + true + fi + +# Make a temp file name in the proper directory. + + dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + + $doit $instcmd $src $dsttmp && + + trap "rm -f ${dsttmp}" 0 && + +# and set any options; do chmod last to preserve setuid bits + +# If any of these fail, we abort the whole thing. If we want to +# ignore errors from any of these, just make sure not to ignore +# errors from the above "$doit $instcmd $src $dsttmp" command. + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && + +# Now rename the file to the real destination. + + $doit $rmcmd -f $dstdir/$dstfile && + $doit $mvcmd $dsttmp $dstdir/$dstfile + +fi && + + +exit 0 diff --git a/web/src/cgi.tcl-1.10/install.mac b/web/src/cgi.tcl-1.10/install.mac new file mode 100644 index 00000000..a79c6b72 --- /dev/null +++ b/web/src/cgi.tcl-1.10/install.mac @@ -0,0 +1,70 @@ +This file is install.mac. It contains installation instructions for +cgi.tcl on MacOS. + +If you do not have Tcl, get it (the README explains how) and install +it. The rest of these instructions assume that you have Tcl +installed. + +-------------------- +Installation +-------------------- + +These instructions are based on contributions courtesy of Henk-Jan +Kooiman <hjk@cable.a2000.nl>. Send fixes to me (libes@nist.gov). + +If you just want to experiment with cgi.tcl, you can simply source it +into your Tcl files by saying "source cgi.tcl". + +Once you're done playing, go ahead and install it. To install it: + +1) Make a package index. (This will create pkgIndex.tcl which will +make it possible to use "package require cgi" in scripts.) Asari +Hirotsugu <asari@math.uiuc.edu> has supplied the following +elaboration of this step: + + 1a) Put the cgi.tcl folder in the "Tool Command Language" folder + inside the Extensions folder. (Don't make an alias for the Tool + Command Language folder since Tcl Shell doesn't resolve aliases as + of 8.2.1.) + + 1b) Launch the Tcl Shell (or Wish) and move to the Tool Command + Language folder by entering: + + cd "Macintosh HD:System Folder:Extensions:Tool Command Language" + + (You may have to modify this command depending upon the names + and structure of your file system.) + + Issue the pkg_mkIndex command: + + pkg_mkIndex cgi.tcl* + + 1c) Test if the package comand works by trying: + + package require cgi + +2) You may want to edit some things in cgi.tcl at this time. + + 2a) Upon errors in production code, cgi.tcl sends mail to an + administrator. This can be set on a per-script basis but it + defaults to "root". You'll probably want to change this for your + site. To do that, search cgi.tcl for cgi_admin_mail_addr "root" and + change the argument to whatever you prefer. + + 2b) The cgi_mail_end procedure attempts to do mail delivery using + SMTP (the de facto Internet mail protocol). However, this mechanism + is not robust. For example, if the mail gateway is down, the mail + will not be requeued for later delivery. If you have a robust + mailer program or some other interface, you should switch to using + it. The ability to send mail isn't required for basic use of + cgi.tcl, but this ability is especially useful for in-the-field + debugging so I encourage you to use it. + +You're done! Now you can use cgi.tcl. + +-------------------- +Examples +-------------------- + +The example directory has some examples. See the README in there. + diff --git a/web/src/cgi.tcl-1.10/install.win b/web/src/cgi.tcl-1.10/install.win new file mode 100644 index 00000000..424fc649 --- /dev/null +++ b/web/src/cgi.tcl-1.10/install.win @@ -0,0 +1,105 @@ +This file is install.win. It contains installation instructions for +cgi.tcl on Win95/NT. + +If you do not have Tcl, get it (the README explains how) and install +it. The rest of these instructions assume that you have Tcl +installed. + +-------------------- +Installation +-------------------- + +These instructions are based on contributions courtesy of Maan +M. Hamze <mmhamze@pleiades.net> and Martin Meuer +<martin.meuer@frz.de>. Send fixes to me (libes@nist.gov). + +If you just want to experiment with cgi.tcl, you can simply source it +into your Tcl files by saying "source cgi.tcl". + +Once you're done playing, go ahead and install it. To install it: + +1) Open wish8.0 and run the following: + + pkg_mkIndex c:\\tcl\\lib\\tcl8.0 cgi.tcl + +(assuming that you have Tcl libraries in the above directory). This +This will create pkgIndex.tcl which will make it possible to use +"package require cgi" in scripts. + +2) The only files actually necessary for production use are +pkgIndex.tcl and cgi.tcl. Make sure those files and their directory +have execute permission for the web server scripts. + +3) You may want to edit some things in cgi.tcl at this time. + +3a) The default extension of the files that work with cgi.tcl is .cgi. +In case that extension is already being used by another program for +your cgi programs, you may want to change that extension into +something else, say, .cgt. To do that, search cgi.tcl for the string +.cgi and replace with .cgt or whatever you prefer. + +3b) Upon errors in production code, cgi.tcl sends mail to an +administrator. This can be set on a per-script basis but it defaults +to "root". You'll probably want to change this for your site. To do +that, search cgi.tcl for cgi_admin_mail_addr "root" and change the +argument to whatever you prefer. + +3c) The cgi_mail_end procedure attempts to do mail delivery using SMTP +(the de facto Internet mail protocol). However, this mechanism is not +robust. For example, if the mail gateway is down, the mail will not +be requeued for later delivery. If you have a robust mailer program +or some other interface, you should switch to using it. The ability +to send mail isn't required for basic use of cgi.tcl, but this ability +is especially useful for in-the-field debugging so I encourage you to +use it. + +4) Tcl/Tk 8.0 should have automatically created a file type to run +files with the .tcl extension. Make sure by running: +Explorer...Options....File Types. .tcl files should be associated +with Wish8.0. + +5) The web server must now be told about Tcl. The exact details +depend on your particular server. Here are instructions that people +have sent to me for different servers. (Feel free to send more.) + +5a) If you are using Personal Web Server for Win 95 or MS IIS ver 3 +for Win NT: + + Instructions according to Maan M. Hamze <mmhamze@pleiades.net> + +Run the Registry Editor. +Go to: +HKEY_LOCAL_MACHINE + System + CurrentControlSet + Services + W3SVC + Parameters + Script Map +Create a new String Value through Edit: +First enter the name of the extension (.cgi or the extension you want to use as +in .cgt). Associate the extension with: +FullPathToTclExecutable\tclsh80.exe %s + +5b) If you are using Netscape Enterprise Server: + + Instructions according to Martin Meuer <martin.meuer@frz.de>. + +5b1) Create an association from NT-Explorer (View-Options-Filetypes) for +the extension .cgt to tell NT to open .cgt with "/fullpath/tclsh80.exe +%1" +5b2) From the Server Manager of the Enterprise Server create o new MIME +type for .cnt with type "magnus-internal/shellcgi" +(Alternatively one can create a special shellCGI-Directory instead, +but I rather like to place my scripts anywhere.) + +6) Kill and restart your web server. + +You're done! Now you can use cgi.tcl. + +-------------------- +Examples +-------------------- + +The example directory has some examples. See the README in there. + diff --git a/web/src/cgi.tcl-1.10/mkinstalldirs b/web/src/cgi.tcl-1.10/mkinstalldirs new file mode 100755 index 00000000..0801ec2c --- /dev/null +++ b/web/src/cgi.tcl-1.10/mkinstalldirs @@ -0,0 +1,32 @@ +#! /bin/sh +# mkinstalldirs --- make directory hierarchy +# Author: Noah Friedman <friedman@prep.ai.mit.edu> +# Created: 1993-05-16 +# Last modified: 1994-03-25 +# Public domain + +errstatus=0 + +for file in ${1+"$@"} ; do + set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` + shift + + pathcomp= + for d in ${1+"$@"} ; do + pathcomp="$pathcomp$d" + case "$pathcomp" in + -* ) pathcomp=./$pathcomp ;; + esac + + if test ! -d "$pathcomp"; then + echo "mkdir $pathcomp" 1>&2 + mkdir "$pathcomp" || errstatus=$? + fi + + pathcomp="$pathcomp/" + done +done + +exit $errstatus + +# mkinstalldirs ends here diff --git a/web/src/cgi.tcl-1.10/pkgcreate b/web/src/cgi.tcl-1.10/pkgcreate new file mode 100755 index 00000000..877b6cb3 --- /dev/null +++ b/web/src/cgi.tcl-1.10/pkgcreate @@ -0,0 +1,9 @@ +#!/depot/path/tclsh +# allow for earlier versions of Tcl that don't define pkg_mkIndex +if {[catch {pkg_mkIndex . cgi.tcl}]} { + set f [open pkgIndex.tcl w] + puts $f "error \"please rebuild cgi.tcl with a modern version of Tcl (for package support)\"" + close $f +} + + diff --git a/web/src/cgi.tcl-1.10/version.in b/web/src/cgi.tcl-1.10/version.in new file mode 100644 index 00000000..86adc5dc --- /dev/null +++ b/web/src/cgi.tcl-1.10/version.in @@ -0,0 +1,2 @@ +set versionFull @CGI_VERSION_FULL@ +set version @CGI_VERSION@ diff --git a/web/src/pubcookie/INSTALL b/web/src/pubcookie/INSTALL new file mode 100644 index 00000000..e4685c40 --- /dev/null +++ b/web/src/pubcookie/INSTALL @@ -0,0 +1,90 @@ +alpine.tar.z web/src/pubcookie/INSTALL +$id$ +/* ======================================================================== + * Copyright 2006-2008 University of Washington + * + * 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 + * + * ======================================================================== + */ + +STEPS TO ADD PUBCOOKIE SUPPORT TO WEB ALPINE +-------------------------------------------- + +UW Pubcookie <http://www.pubcookie.org> provides single-sign-on +service for web-based applications. Web Alpine can be built to use UW +Pubcookie within a Kerberos authorization framework. + +Building Web Alpine to use pubcookie authentication should be +accomplished by simply adding: + + --with-pubcookie + +and: + + --with-web-bin=/usr/local/libexec/alpine/bin + +to the configure script's command line. Note, the value you supply in +the second configure option is the directory where ultimately the Web +Alpine's binary support tools will be installed. In addition, +Kerberos 5 must be available on the Alpine web server. + +Installation of the extra binary components for pubcookie support +should happen automatically. After the "make install" command typed +in web/src directory completes successfully, verify that: + + web/bin/wp_uidmapper + web/bin/wp_tclsh + web/bin/wp_gssapi_proxy + +all exist. Then simply follow the normal Web Alpine installation +steps described in the web/INSTALL document. + +Once Web Alpine is installed, there is some additional configuration +required. First, you'll need to change permissions on a couple of the +binary components as they do make use of the setuid() system call. It +should be simply a matter of: + + cd /usr/local/libexec/alpine/bin + sudo chmod 4755 wp_gssapi_proxy wp_tclsh + +Next, you'll need to: + + cd /usr/local/libexec/alpine/cgi/session + +In that directory you'll need to edit the ".htaccess" file, adding the +lines contained in the example htaccess file in the distribution's +"web/src/pubcookie/_htaccess_session". + +Then, + + cd /usr/local/libexec/alpine/cgi/session + +and edit the ".htaccess" file therein, adding the lines contained in +the example file "web/src/pubcookie/_htaccess_session_logout". + +Running Web Alpine with pubcookie requires some extra care and +feeding. First, the service provided by "wp_uidmapper" must be +started and maintained as long as the web server is providing Web +Alpine service. It must be run under the same uid as the web server. +The helper script "debug.cgi" can be used to conveniently +start/restart the wp_uidmapper service. Make sure the path defined +within that script is correct for your system. + +Finally, you'll need to create within the Kerberos 5 system the ID of +the "IMAP Superuser". This userid is used by the web server to log +into the UW IMAP server via SASL proxy authentication. That is, to +establish an IMAP session, the web server logs into the IMAP server +via Kerberos as the IMAP Superuser (which must be configured on the +IMAP server separately) and specifies in that SASL exchange that login +in being performed on behalf of the UW Pubcookie-provided userid. + +With the IMAP Superuser ID established and configured on the IMAP +server, you'll need to acquire a Kerbero ticket on the web server. +Typically, you'll want to install a crontab entry to periodically +refresh the ticket. See web/src/pubcookie/README. + diff --git a/web/src/pubcookie/Makefile.am b/web/src/pubcookie/Makefile.am new file mode 100644 index 00000000..e4da1c39 --- /dev/null +++ b/web/src/pubcookie/Makefile.am @@ -0,0 +1,37 @@ +## Process this file with automake to produce Makefile.in +## Use aclocal -I m4; automake + +# ======================================================================== +# Copyright 2006-2008 University of Washington +# +# 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 +# +# ======================================================================== + + +WP_UIDMAPPER_SOCKET = "/tmp/wp_uidmapper" +WEBSERVER_UID = 65534 + +CFLAGS = '-DWP_UIDMAPPER_SOCKET=$(WP_UIDMAPPER_SOCKET)' \ + '-DWEBSERVER_UID=$(WEBSERVER_UID)' \ + '-DAUTH_GSS_PROXY_PATH="$(WEB_BINDIR)/wp_gssapi_proxy"' + +bin_PROGRAMS = wp_uidmapper wp_tclsh wp_gssapi_proxy wp_umc + +noinst_LIBRARIES = libauthgssproxy.a + +libauthgssproxy_a_SOURCES = auth_gss_proxy.c + +wp_uidmapper_SOURCES = wp_uidmapper.c id_table.c id_table.h + +wp_tclsh_SOURCES = wp_tclsh.c wp_uidmapper_lib.c + +wp_gssapi_proxy_SOURCES = wp_gssapi_proxy.c wp_uidmapper_lib.c + +wp_umc_SOURCES = wp_umc.c wp_uidmapper_lib.c + +AM_CPPFLAGS = -I@top_builddir@/include -I@top_srcdir@/include diff --git a/web/src/pubcookie/Makefile.in b/web/src/pubcookie/Makefile.in new file mode 100644 index 00000000..c353b8ba --- /dev/null +++ b/web/src/pubcookie/Makefile.in @@ -0,0 +1,621 @@ +# Makefile.in generated by automake 1.11.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, +# Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# ======================================================================== +# Copyright 2006-2008 University of Washington +# +# 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 +# +# ======================================================================== + + +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +bin_PROGRAMS = wp_uidmapper$(EXEEXT) wp_tclsh$(EXEEXT) \ + wp_gssapi_proxy$(EXEEXT) wp_umc$(EXEEXT) +subdir = web/src/pubcookie +DIST_COMMON = README $(srcdir)/Makefile.am $(srcdir)/Makefile.in \ + INSTALL +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/acx_pthread.m4 \ + $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ + $(top_srcdir)/m4/lib-ld.m4 $(top_srcdir)/m4/lib-link.m4 \ + $(top_srcdir)/m4/lib-prefix.m4 $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/po.m4 \ + $(top_srcdir)/m4/progtest.m4 $(top_srcdir)/VERSION \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs +CONFIG_HEADER = $(top_builddir)/include/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +ARFLAGS = cru +libauthgssproxy_a_AR = $(AR) $(ARFLAGS) +libauthgssproxy_a_LIBADD = +am_libauthgssproxy_a_OBJECTS = auth_gss_proxy.$(OBJEXT) +libauthgssproxy_a_OBJECTS = $(am_libauthgssproxy_a_OBJECTS) +am__installdirs = "$(DESTDIR)$(bindir)" +PROGRAMS = $(bin_PROGRAMS) +am_wp_gssapi_proxy_OBJECTS = wp_gssapi_proxy.$(OBJEXT) \ + wp_uidmapper_lib.$(OBJEXT) +wp_gssapi_proxy_OBJECTS = $(am_wp_gssapi_proxy_OBJECTS) +wp_gssapi_proxy_LDADD = $(LDADD) +am_wp_tclsh_OBJECTS = wp_tclsh.$(OBJEXT) wp_uidmapper_lib.$(OBJEXT) +wp_tclsh_OBJECTS = $(am_wp_tclsh_OBJECTS) +wp_tclsh_LDADD = $(LDADD) +am_wp_uidmapper_OBJECTS = wp_uidmapper.$(OBJEXT) id_table.$(OBJEXT) +wp_uidmapper_OBJECTS = $(am_wp_uidmapper_OBJECTS) +wp_uidmapper_LDADD = $(LDADD) +am_wp_umc_OBJECTS = wp_umc.$(OBJEXT) wp_uidmapper_lib.$(OBJEXT) +wp_umc_OBJECTS = $(am_wp_umc_OBJECTS) +wp_umc_LDADD = $(LDADD) +DEFAULT_INCLUDES = +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +CCLD = $(CC) +LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \ + $(LDFLAGS) -o $@ +SOURCES = $(libauthgssproxy_a_SOURCES) $(wp_gssapi_proxy_SOURCES) \ + $(wp_tclsh_SOURCES) $(wp_uidmapper_SOURCES) $(wp_umc_SOURCES) +DIST_SOURCES = $(libauthgssproxy_a_SOURCES) $(wp_gssapi_proxy_SOURCES) \ + $(wp_tclsh_SOURCES) $(wp_uidmapper_SOURCES) $(wp_umc_SOURCES) +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_CFLAGS = @AM_CFLAGS@ +AM_LDFLAGS = @AM_LDFLAGS@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = '-DWP_UIDMAPPER_SOCKET=$(WP_UIDMAPPER_SOCKET)' \ + '-DWEBSERVER_UID=$(WEBSERVER_UID)' \ + '-DAUTH_GSS_PROXY_PATH="$(WEB_BINDIR)/wp_gssapi_proxy"' + +CP = @CP@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +C_CLIENT_CFLAGS = @C_CLIENT_CFLAGS@ +C_CLIENT_GCCOPTLEVEL = @C_CLIENT_GCCOPTLEVEL@ +C_CLIENT_LDFLAGS = @C_CLIENT_LDFLAGS@ +C_CLIENT_SPECIALS = @C_CLIENT_SPECIALS@ +C_CLIENT_TARGET = @C_CLIENT_TARGET@ +C_CLIENT_WITH_IPV6 = @C_CLIENT_WITH_IPV6@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +GMSGFMT = @GMSGFMT@ +GMSGFMT_015 = @GMSGFMT_015@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +INTLLIBS = @INTLLIBS@ +INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ +ISPELLPROG = @ISPELLPROG@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBICONV = @LIBICONV@ +LIBINTL = @LIBINTL@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN = @LN@ +LN_S = @LN_S@ +LTLIBICONV = @LTLIBICONV@ +LTLIBINTL = @LTLIBINTL@ +LTLIBOBJS = @LTLIBOBJS@ +MAINT = @MAINT@ +MAKE = @MAKE@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +MSGFMT = @MSGFMT@ +MSGFMT_015 = @MSGFMT_015@ +MSGMERGE = @MSGMERGE@ +NM = @NM@ +NMEDIT = @NMEDIT@ +NPA_PROG = @NPA_PROG@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +POSUB = @POSUB@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +PWPROG = @PWPROG@ +RANLIB = @RANLIB@ +REGEX_BUILD = @REGEX_BUILD@ +RM = @RM@ +SED = @SED@ +SENDMAIL = @SENDMAIL@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SPELLPROG = @SPELLPROG@ +STRIP = @STRIP@ +USE_NLS = @USE_NLS@ +VERSION = @VERSION@ +WEB_BINDIR = @WEB_BINDIR@ +WEB_BUILD = @WEB_BUILD@ +WEB_PUBCOOKIE_BUILD = @WEB_PUBCOOKIE_BUILD@ +WEB_PUBCOOKIE_LIB = @WEB_PUBCOOKIE_LIB@ +WEB_PUBCOOKIE_LINK = @WEB_PUBCOOKIE_LINK@ +XGETTEXT = @XGETTEXT@ +XGETTEXT_015 = @XGETTEXT_015@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +acx_pthread_config = @acx_pthread_config@ +alpine_interactive_spellcheck = @alpine_interactive_spellcheck@ +alpine_simple_spellcheck = @alpine_simple_spellcheck@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_ECHO = @lt_ECHO@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +WP_UIDMAPPER_SOCKET = "/tmp/wp_uidmapper" +WEBSERVER_UID = 65534 +noinst_LIBRARIES = libauthgssproxy.a +libauthgssproxy_a_SOURCES = auth_gss_proxy.c +wp_uidmapper_SOURCES = wp_uidmapper.c id_table.c id_table.h +wp_tclsh_SOURCES = wp_tclsh.c wp_uidmapper_lib.c +wp_gssapi_proxy_SOURCES = wp_gssapi_proxy.c wp_uidmapper_lib.c +wp_umc_SOURCES = wp_umc.c wp_uidmapper_lib.c +AM_CPPFLAGS = -I@top_builddir@/include -I@top_srcdir@/include +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .lo .o .obj +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign web/src/pubcookie/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign web/src/pubcookie/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) +libauthgssproxy.a: $(libauthgssproxy_a_OBJECTS) $(libauthgssproxy_a_DEPENDENCIES) + -rm -f libauthgssproxy.a + $(libauthgssproxy_a_AR) libauthgssproxy.a $(libauthgssproxy_a_OBJECTS) $(libauthgssproxy_a_LIBADD) + $(RANLIB) libauthgssproxy.a +install-binPROGRAMS: $(bin_PROGRAMS) + @$(NORMAL_INSTALL) + test -z "$(bindir)" || $(MKDIR_P) "$(DESTDIR)$(bindir)" + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + for p in $$list; do echo "$$p $$p"; done | \ + sed 's/$(EXEEXT)$$//' | \ + while read p p1; do if test -f $$p || test -f $$p1; \ + then echo "$$p"; echo "$$p"; else :; fi; \ + done | \ + sed -e 'p;s,.*/,,;n;h' -e 's|.*|.|' \ + -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ + sed 'N;N;N;s,\n, ,g' | \ + $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ + { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ + if ($$2 == $$4) files[d] = files[d] " " $$1; \ + else { print "f", $$3 "/" $$4, $$1; } } \ + END { for (d in files) print "f", d, files[d] }' | \ + while read type dir files; do \ + if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ + test -z "$$files" || { \ + echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \ + $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ + } \ + ; done + +uninstall-binPROGRAMS: + @$(NORMAL_UNINSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + files=`for p in $$list; do echo "$$p"; done | \ + sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ + -e 's/$$/$(EXEEXT)/' `; \ + test -n "$$list" || exit 0; \ + echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(bindir)" && rm -f $$files + +clean-binPROGRAMS: + @list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \ + echo " rm -f" $$list; \ + rm -f $$list || exit $$?; \ + test -n "$(EXEEXT)" || exit 0; \ + list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \ + echo " rm -f" $$list; \ + rm -f $$list +wp_gssapi_proxy$(EXEEXT): $(wp_gssapi_proxy_OBJECTS) $(wp_gssapi_proxy_DEPENDENCIES) + @rm -f wp_gssapi_proxy$(EXEEXT) + $(LINK) $(wp_gssapi_proxy_OBJECTS) $(wp_gssapi_proxy_LDADD) $(LIBS) +wp_tclsh$(EXEEXT): $(wp_tclsh_OBJECTS) $(wp_tclsh_DEPENDENCIES) + @rm -f wp_tclsh$(EXEEXT) + $(LINK) $(wp_tclsh_OBJECTS) $(wp_tclsh_LDADD) $(LIBS) +wp_uidmapper$(EXEEXT): $(wp_uidmapper_OBJECTS) $(wp_uidmapper_DEPENDENCIES) + @rm -f wp_uidmapper$(EXEEXT) + $(LINK) $(wp_uidmapper_OBJECTS) $(wp_uidmapper_LDADD) $(LIBS) +wp_umc$(EXEEXT): $(wp_umc_OBJECTS) $(wp_umc_DEPENDENCIES) + @rm -f wp_umc$(EXEEXT) + $(LINK) $(wp_umc_OBJECTS) $(wp_umc_LDADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/auth_gss_proxy.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/id_table.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wp_gssapi_proxy.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wp_tclsh.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wp_uidmapper.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wp_uidmapper_lib.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wp_umc.Po@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'` + +.c.lo: +@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + set x; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: CTAGS +CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) $(PROGRAMS) +installdirs: + for dir in "$(DESTDIR)$(bindir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-binPROGRAMS clean-generic clean-libtool \ + clean-noinstLIBRARIES mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-binPROGRAMS + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-binPROGRAMS + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS all all-am check check-am clean clean-binPROGRAMS \ + clean-generic clean-libtool clean-noinstLIBRARIES ctags \ + distclean distclean-compile distclean-generic \ + distclean-libtool distclean-tags distdir dvi dvi-am html \ + html-am info info-am install install-am install-binPROGRAMS \ + install-data install-data-am install-dvi install-dvi-am \ + install-exec install-exec-am install-html install-html-am \ + install-info install-info-am install-man install-pdf \ + install-pdf-am install-ps install-ps-am install-strip \ + installcheck installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-compile \ + mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ + tags uninstall uninstall-am uninstall-binPROGRAMS + + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/web/src/pubcookie/README b/web/src/pubcookie/README new file mode 100644 index 00000000..9ca8a493 --- /dev/null +++ b/web/src/pubcookie/README @@ -0,0 +1,137 @@ +alpine.tar.z web/src/pubcookie/README +/* ======================================================================== + * Copyright 2006-2008 University of Washington + * + * 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 + * + * ======================================================================== + */ + +WEB ALPINE WITH PUBCOOKIE SUPPORT +--------------------------------- + +UW Pubcookie <http://www.pubcookie.org> provides single-sign-on +service for web-based applications. + +For building and installation comments, see web/src/pubcookie/INSTALL. + + +WEB ALPINE PUBCOOKIE COMPONENTS +------------------------------- + +Below are the extra binary helper applications and their descriptions +necessary to implement UW Pubcookie authentication within Web Alpine. + +bin/wp_uidmapper: + wp_uidmapper runs in background. Keeps pubcookie + username <-> uid tables. Handles requests from + wp_tclsh and wp_gssapi_proxy through the named socket + /tmp/wp_uidmapper. This needs to be manually started, + should never stop running, and should run as the same + uid as the web server (nobody). + +bin/wp_tclsh: + + wp_tclsh is a modified version of tclsh (8.0.5) that + does a setuid before doing the tcl stuff. The tcl + scripts directly run by the web server should use this + as their #! interpreter. If REMOTE_USER is set + (pubcookie in use) and the calling uid is the web + server (nobody), it calls wp_uidmapper to obtain its + destination uid. Otherwise, it just changes back to + the calling uid. + + +bin/wp_gssapi_proxy: + + wp_gssapi_proxy is called by the c-client + auth_gss_proxy.c routine, and does the GSSAPI/SASL + dance with the imap server. Looks up the username + corresponding to the calling uid via wp_uidmapper, and + will fail if the calling program is requesting access + to a different username's mail on the imap + server. Compile time options for wp_gssapi_proxy: + + -DDDEBUG: outputs extra info to the syslog mail log. + -DNO_UIDMAPPER: calls getpwuid(getuid()) to look up + username of calling uid. + +bin/alpined + + auth_gss_proxy.c is the c-client authenticator that calls + wp_gssapi_proxy. Stick this in the imap/src/c-client directory + of the pinetcl source tree. Make sure the + AUTH_GSS_PROXY_PATH #define points to the location of + the installed wp_gssapi_proxy. The following lines + should be added to main() function in pine/pinetcl.c: + + /* put this auth_link at the beginning of the list */ + auth_link(&auth_gss_proxy); + /* try to get username from REMOTE_USER (pubcookie) */ + if(user = getenv("REMOTE_USER")) env_init(user,"/"); + +*.tcl: + + The scripts directly run by the web server must be + changed to point to wp_tclsh instead of the normal + tclsh. If for some reason you want to create a script + that should be run as the web server uid, use the + default tclsh interpreter. There is a script + bin/chscriptinterp, which you can run as follows to + change *.tcl to use /www/test/bin/wp_tclsh instead of + whatever they currently use. + +.htaccess: + + AuthType UWNetID + AuthName "Webpine" + PubcookieAppId "Webpine" + require valid-user + + NOTE: to properly scope the pubcookie cookie for the web server, + remove the PubcookieAppId directive + +logout/.htaccess: + + PubcookieEndSesion redirect + +etc/webpine.keytab: + + Should be owned by nobody.nobody with 600 permissions. A cron + entry for user nobody should run kinit often enough so that + the ticket never expires: + + [root@server /]# crontab -u nobody -l + # DO NOT EDIT THIS FILE - edit the master and reinstall. + # (/var/spool/cron.new/nobody installed on Tue Dec 5 16:26:14 2000) + # (Cron version -- $Id: README 910 2008-01-14 22:28:38Z hubert@u.washington.edu $) + MAILTO=root@your-server-name + 0 3,11,19 * * * /usr/local/bin/kinit -k -t /www/test/etc/webpine.keytab webpine + +debug.cgi: + + If you are having weird problems, run this via your web + browser, and it might help you figure things out. Runs as the web + server uid (nobody) and displays the following: + + - output of 'klist' + - output of 'ps auxww |grep wp_uidmapper' + - the environment + - also lists any processes running as uids with no + corresponding usernames, which should tell you if your + pinetcl process is crashing. + + It also will restart wp_uidmapper if /tmp/wp_uidmapper does not + exist, should that have crashed for some reason. + + Finally, visit debug.cgi?stop (via the web browser) and it + will stop a currently running wp_uidmapper, so that you can + restart it in case you do something like move the location of + the binary. + +-- +$Id: README 910 2008-01-14 22:28:38Z hubert@u.washington.edu $ diff --git a/web/src/pubcookie/_htaccess_session b/web/src/pubcookie/_htaccess_session new file mode 100644 index 00000000..24855aab --- /dev/null +++ b/web/src/pubcookie/_htaccess_session @@ -0,0 +1,4 @@ +AuthType UWNetID +AuthName "Webpine" +PubcookieAppId "Webpine" +require valid-user diff --git a/web/src/pubcookie/_htaccess_session_logout b/web/src/pubcookie/_htaccess_session_logout new file mode 100644 index 00000000..ecc269e1 --- /dev/null +++ b/web/src/pubcookie/_htaccess_session_logout @@ -0,0 +1,8 @@ +# +# mod_rewrite rules to coerce secure (https) access to underlying pages +# + +AddHandler cgi-script tcl + +PubcookieAppId "Webpine" +PubcookieEndSession redirect diff --git a/web/src/pubcookie/auth_gss_proxy.c b/web/src/pubcookie/auth_gss_proxy.c new file mode 100644 index 00000000..ea5daf69 --- /dev/null +++ b/web/src/pubcookie/auth_gss_proxy.c @@ -0,0 +1,380 @@ +/* ======================================================================== + * Copyright 2006-2008 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include "../../../c-client/mail.h" +#include "../../../c-client/misc.h" +#include "../../../c-client/osdep.h" + +#define PROTOTYPE(x) x +#include <gssapi/gssapi_generic.h> +#include <gssapi/gssapi_krb5.h> + +long auth_gssapi_proxy_valid (void); +long auth_gssapi_proxy_client (authchallenge_t challenger, + authrespond_t responder, + char *service, + NETMBX *mb,void *stream,unsigned long *trial, + char *user); +char *auth_gssapi_proxy_server (authresponse_t responder,int argc,char *argv[]); + +AUTHENTICATOR auth_gss_proxy = { + AU_SECURE | AU_AUTHUSER, /* secure authenticator */ + "GSSAPI", /* authenticator name */ + auth_gssapi_proxy_valid, /* check if valid */ + auth_gssapi_proxy_client, /* client method */ + auth_gssapi_proxy_server, /* server method */ + NIL /* next authenticator */ +}; + +#define AUTH_GSSAPI_P_NONE 1 +#define AUTH_GSSAPI_P_INTEGRITY 2 +#define AUTH_GSSAPI_P_PRIVACY 4 + +#define AUTH_GSSAPI_C_MAXSIZE 8192 + +#define SERVER_LOG(x,y) syslog (LOG_ALERT,x,y) + +extern char *krb5_defkeyname; /* sneaky way to get this name */ + + +/* Placate const declarations */ + +static gss_OID auth_gss_proxy_mech; +static gss_OID_set auth_gss_proxy_mech_set; + +/* Check if GSSAPI valid on this system + * Returns: T if valid, NIL otherwise + */ + +long auth_gssapi_proxy_valid (void) +{ + char *s,tmp[MAILTMPLEN]; + OM_uint32 smn; + gss_buffer_desc buf; + gss_name_t name; + struct stat sbuf; + sprintf (tmp,"host@%s",mylocalhost ()); + buf.length = strlen (buf.value = tmp) + 1; + memcpy (&auth_gss_proxy_mech,&gss_mech_krb5,sizeof (gss_OID)); + memcpy (&auth_gss_proxy_mech_set,&gss_mech_set_krb5,sizeof (gss_OID_set)); + /* see if can build a name */ + if (gss_import_name (&smn,&buf,gss_nt_service_name,&name) != GSS_S_COMPLETE) + return NIL; /* failed */ + if ((s = strchr (krb5_defkeyname,':')) && stat (++s,&sbuf)) + auth_gss_proxy.server = NIL; /* can't do server if no keytab */ + gss_release_name (&smn,&name);/* finished with name */ + return LONGT; +} + +/* Proxy client authenticator (mihodge) + * Accepts: challenger function + * responder function + * parsed network mailbox structure + * stream argument for functions + * pointer to current trial count + * returned user name + * Returns: T if success, NIL otherwise, number of trials incremented if retry + */ + +#ifndef AUTH_GSS_PROXY_PATH +#define AUTH_GSS_PROXY_PATH "/usr/local/libexec/alpine/bin/wp_gssapi_proxy" +#endif +#define AUTH_GSS_PROXY_MESSAGE 1 +#define AUTH_GSS_PROXY_READ 2 +#define AUTH_GSS_PROXY_SUCCESS 3 +#define AUTH_GSS_PROXY_WRITE 4 +#define AUTH_GSS_PROXY_WRITE_NIL 5 +#define AUTH_GSS_PROXY_EXEC_FAILED 6 + +static unsigned long read_full(int fd,void *buf,unsigned long size) { + unsigned long total,s; + for(total = 0; total < size; total += s) { + s = read(fd,(char*)buf + total,size - total); + if(s == -1) { + if((errno == EAGAIN) || (errno == EINTR)) s = 0; + else return -1; + } else if(s == 0) break; + } + return total; +} + +static unsigned long write_full(int fd,void *buf,unsigned long size) { + unsigned long total,s; + for(total = 0; total < size; total += s) { + s = write(fd,(char*)buf + total,size - total); + if(s == -1) { + if((errno == EAGAIN) || (errno == EINTR)) s = 0; + else return -1; + } + } + return total; +} + +long auth_gssapi_proxy_client (authchallenge_t challenger, + authrespond_t responder, + char *service, + NETMBX *mb,void *stream,unsigned long *trial, + char *user) +{ + char err[MAILTMPLEN]; + int status, ipipe[2], opipe[2]; + unsigned long len,cmd[2],maxlogintrials; + char *buf; + pid_t pid; + long ret = NIL; + + imap_parameters(GET_MAXLOGINTRIALS, (void *) &maxlogintrials); + *trial = maxlogintrials + 1; + err[0] = 0; + strcpy (user,mb->user[0] ? mb->user : myusername ()); + + /* open pipe to gss proxy process */ + if(pipe(ipipe)) { + sprintf (err,"auth_gss_proxy: create pipe error: %s",strerror(errno)); + } else if(pipe(opipe)) { + sprintf (err,"auth_gss_proxy: create pipe error: %s",strerror(errno)); + close(ipipe[0]); + close(ipipe[1]); + } else if((pid = fork()) == -1) { + sprintf (err,"auth_gss_proxy: fork error: %s",strerror(errno)); + close(ipipe[0]); + close(ipipe[1]); + close(opipe[0]); + close(opipe[1]); + + } else if(pid == 0) { /* child process */ + close(ipipe[0]); + close(opipe[1]); + dup2(opipe[0],0); + dup2(ipipe[1],1); + close(opipe[0]); + close(ipipe[1]); + + /* a little overloading of the "err" field here */ + sprintf (err,"%s@%s",service,mb->host); + execlp(AUTH_GSS_PROXY_PATH,AUTH_GSS_PROXY_PATH,err,user,0); + + /* tell parent that exec failed and exit */ + cmd[0] = AUTH_GSS_PROXY_EXEC_FAILED; + cmd[1] = 0; + write_full(1,cmd,sizeof(cmd)); + exit(-1); + + } else { /* parent process */ + close(ipipe[1]); + close(opipe[0]); + + while(len = read_full(ipipe[0],cmd,sizeof(cmd))) { + if (len == -1) { + sprintf (err,"auth_gss_proxy: read error: %s",strerror(errno)); + break; + } else if (len != sizeof(cmd)) { + sprintf (err,"auth_gss_proxy: read error: %lu out of %lu", + len,sizeof(cmd)); + break; + + } else if(cmd[0] == AUTH_GSS_PROXY_EXEC_FAILED) { + sprintf (err,"auth_gss_proxy: could not spawn proxy process"); + break; + + } else if(cmd[0] == AUTH_GSS_PROXY_MESSAGE) { + if(cmd[1]) { + buf = fs_get(cmd[1]); + len = read_full(ipipe[0],buf,cmd[1]); + if(len == -1) { + sprintf (err,"auth_gss_proxy: read error: %s",strerror(errno)); + break; + } else if(len != cmd[1]) { + sprintf (err,"auth_gss_proxy: read error: %lu out of %lu", + len,cmd[1]); + break; + } else { + mm_log(buf,WARN); + } + fs_give ((void **) &buf); + } + + } else if(cmd[0] == AUTH_GSS_PROXY_READ) { + buf = (*challenger) (stream,&len); + if(!buf) len = 0; + if(write_full(opipe[1],&len,sizeof(len)) == -1) { + sprintf (err,"auth_gss_proxy: write error: %s",strerror(errno)); + break; + } else if (buf && (write_full(opipe[1],buf,len) == -1)) { + sprintf (err,"auth_gss_proxy: write error: %s",strerror(errno)); + break; + } + if(buf) fs_give ((void **) &buf); + + } else if(cmd[0] == AUTH_GSS_PROXY_SUCCESS) { + ret = T; + + } else if(cmd[0] == AUTH_GSS_PROXY_WRITE) { + if(cmd[1]) { + buf = fs_get(cmd[1]); + len = read_full(ipipe[0],buf,cmd[1]); + if(len == -1) { + sprintf (err,"auth_gss_proxy: read error: %s",strerror(errno)); + break; + } else if(len != cmd[1]) { + sprintf (err,"auth_gss_proxy: read error: %lu out of %lu", + len,cmd[1]); + break; + } else { + (*responder) (stream,buf,cmd[1]); + } + fs_give ((void **) &buf); + } else { + (*responder) (stream,"",0); + } + + } else if(cmd[0] == AUTH_GSS_PROXY_WRITE_NIL) { + (*responder) (stream,NIL,0); + + } else { + sprintf (err,"auth_gss_proxy: unknown command: %lu",cmd[0]); + break; + } + } + + /* close pipes and wait for process to die */ + close(ipipe[0]); + waitpid(pid,&status,0); + close(opipe[1]); + } + + if(err[0]) mm_log(err,WARN); + return ret; +} + +/* Server authenticator + * Accepts: responder function + * argument count + * argument vector + * Returns: authenticated user name or NIL + */ + +char *auth_gssapi_proxy_server (authresponse_t responder,int argc,char *argv[]) +{ + char *ret = NIL; + char *s,tmp[MAILTMPLEN]; + unsigned long maxsize = htonl (AUTH_GSSAPI_C_MAXSIZE); + int conf; + OM_uint32 smj,smn,dsmj,dsmn,flags; + OM_uint32 mctx = 0; + gss_name_t crname,name; + gss_OID mech; + gss_buffer_desc chal,resp,buf; + gss_cred_id_t crd; + gss_ctx_id_t ctx = GSS_C_NO_CONTEXT; + gss_qop_t qop = GSS_C_QOP_DEFAULT; + /* make service name */ + sprintf (tmp,"%s@%s",(char *) mail_parameters (NIL,GET_SERVICENAME,NIL), + tcp_serverhost ()); + buf.length = strlen (buf.value = tmp) + 1; + /* acquire credentials */ + if ((gss_import_name (&smn,&buf,gss_nt_service_name,&crname)) == + GSS_S_COMPLETE) { + if ((smj = gss_acquire_cred (&smn,crname,0,auth_gss_proxy_mech_set,GSS_C_ACCEPT, + &crd,NIL,NIL)) == GSS_S_COMPLETE) { + if (resp.value = (*responder) ("",0,(unsigned long *) &resp.length)) { + do { /* negotiate authentication */ + smj = gss_accept_sec_context (&smn,&ctx,crd,&resp, + GSS_C_NO_CHANNEL_BINDINGS,&name,&mech, + &chal,&flags,NIL,NIL); + /* don't need response any more */ + fs_give ((void **) &resp.value); + switch (smj) { /* how did it go? */ + case GSS_S_COMPLETE: /* successful */ + /* paranoia */ + if (memcmp (mech->elements,auth_gss_proxy_mech->elements,mech->length)) + fatal ("GSSAPI is bogus"); + case GSS_S_CONTINUE_NEEDED: + if (chal.value) { /* send challenge, get next response */ + resp.value = (*responder) (chal.value,chal.length, + (unsigned long *) &resp.length); + gss_release_buffer (&smn,&chal); + } + break; + } + } + while (resp.value && resp.length && (smj == GSS_S_CONTINUE_NEEDED)); + + /* successful exchange? */ + if ((smj == GSS_S_COMPLETE) && + (gss_display_name (&smn,name,&buf,&mech) == GSS_S_COMPLETE)) { + /* extract authentication ID from principal */ + if (s = strchr ((char *) buf.value,'@')) *s = '\0'; + /* send security and size */ + memcpy (resp.value = tmp,(void *) &maxsize,resp.length = 4); + tmp[0] = AUTH_GSSAPI_P_NONE; + if (gss_wrap (&smn,ctx,NIL,qop,&resp,&conf,&chal) == GSS_S_COMPLETE){ + resp.value = (*responder) (chal.value,chal.length, + (unsigned long *) &resp.length); + gss_release_buffer (&smn,&chal); + if (gss_unwrap (&smn,ctx,&resp,&chal,&conf,&qop)==GSS_S_COMPLETE) { + /* client request valid */ + if (chal.value && (chal.length > 4) && (chal.length < MAILTMPLEN) + && memcpy (tmp,chal.value,chal.length) && + (tmp[0] & AUTH_GSSAPI_P_NONE)) { + /* tie off authorization ID */ + tmp[chal.length] = '\0'; + if (authserver_login (tmp+4,buf.value,argc,argv) || + authserver_login (lcase (tmp+4),buf.value,argc,argv)) + ret = myusername (); + } + /* done with user name */ + gss_release_buffer (&smn,&chal); + } + /* finished with response */ + fs_give ((void **) &resp.value); + } + /* don't need name buffer any more */ + gss_release_buffer (&smn,&buf); + } + /* don't need client name any more */ + gss_release_name (&smn,&name); + /* don't need context any more */ + if (ctx != GSS_C_NO_CONTEXT) gss_delete_sec_context (&smn,&ctx,NIL); + } + /* finished with credentials */ + gss_release_cred (&smn,&crd); + } + + else { /* can't acquire credentials! */ + if (gss_display_name (&dsmn,crname,&buf,&mech) == GSS_S_COMPLETE) + SERVER_LOG ("Failed to acquire credentials for %s",buf.value); + if (smj != GSS_S_FAILURE) do + switch (dsmj = gss_display_status (&dsmn,smj,GSS_C_GSS_CODE, + GSS_C_NO_OID,&mctx,&resp)) { + case GSS_S_COMPLETE: + mctx = 0; + case GSS_S_CONTINUE_NEEDED: + SERVER_LOG ("Unknown GSSAPI failure: %s",resp.value); + gss_release_buffer (&dsmn,&resp); + } + while (dsmj == GSS_S_CONTINUE_NEEDED); + do switch (dsmj = gss_display_status (&dsmn,smn,GSS_C_MECH_CODE, + GSS_C_NO_OID,&mctx,&resp)) { + case GSS_S_COMPLETE: + case GSS_S_CONTINUE_NEEDED: + SERVER_LOG ("GSSAPI mechanism status: %s",resp.value); + gss_release_buffer (&dsmn,&resp); + } + while (dsmj == GSS_S_CONTINUE_NEEDED); + } + /* finished with credentials name */ + gss_release_name (&smn,&crname); + } + return ret; /* return status */ +} diff --git a/web/src/pubcookie/debug.cgi b/web/src/pubcookie/debug.cgi new file mode 100755 index 00000000..dd998380 --- /dev/null +++ b/web/src/pubcookie/debug.cgi @@ -0,0 +1,58 @@ +#!/usr/bin/perl +$| = 1; +$wp_uidmapper_bin = "/usr/local/libexec/alpine/bin/wp_uidmapper"; +$wp_uidmapper_socket = "/tmp/wp_uidmapper"; + +print "Content-type: text/plain\n\n"; +print "klist:\n"; +system("/usr/local/bin/klist"); +print "\n"; + +#if($ENV{'QUERY_STRING'} eq 'stop') { +# foreach $line (ps("axww")) { +# ($line =~ m/^(\d+).*wp_uidmapper/) && kill(15,$1); +# } +# sleep(1); +# if(-e $wp_uidmapper_socket) { +# print "Could not kill wp_uidmapper\n"; +# exit(1); +# } +# print "wp_uidmapper stopped\n"; +# exit 0; +#} + +if (! -e $wp_uidmapper_socket) { + print "Yikes! need to spawn new wp_uidmapper process\n"; + if(!fork()) { + close(STDIN); + close(STDOUT); + close(STDERR); + setpgrp(0,0); + exec("$wp_uidmapper_bin 60000-64999"); + } + sleep 1; +} + +@ps = ps("auxww"); +print "wp_uidmapper:\n"; +foreach $line (@ps) { ($line =~ m/wp_uidmapper/) && print $line; } + +print "\nEnvironment:\n"; +foreach $key (sort { $a cmp $b } keys(%ENV)) { + print "$key: $ENV{$key}\n"; +} + +print "\nAlpine user processes:\n"; +foreach $line (@ps) { ($line =~ m/^\#/) && print $line; } +exit 0; + +sub ps { + my ($args) = @_; + my (@a); + open(PS,"ps $args|") || return; + @a = <PS>; + close(PS); + return @a; +} + + diff --git a/web/src/pubcookie/id_table.c b/web/src/pubcookie/id_table.c new file mode 100644 index 00000000..1076524e --- /dev/null +++ b/web/src/pubcookie/id_table.c @@ -0,0 +1,294 @@ +#include "id_table.h" +#include "wp_uidmapper_lib.h" + +#include <sys/types.h> /* opendir */ +#include <sys/stat.h> /* stat */ +#include <stdlib.h> /* mallloc,free,strtol */ +#include <string.h> /* memcpy */ +#include <errno.h> /* errno */ + +#include <dirent.h> /* opendir */ +#include <unistd.h> /* stat */ + +unsigned long hash_func(char *string,unsigned long num_buckets) { + unsigned long i; + char *p; + for(i = 0, p = string; *p; p++) i = (9 * i) + *p; + return i % num_buckets; +} + +struct id_table_entry { + struct id_table_entry **pself; + struct id_table_entry *next; + int id; + char tmp; + char name[1]; +}; + +struct key_hash_entry { + unsigned key[WP_KEY_LEN]; + id_table_entry *e; + struct key_hash_entry **pself; + struct key_hash_entry *next; +}; + +id_table_range *id_table_range_new(char *str) { + id_table_range *rhead,*rtail; + char *p,*pn; + long s,e; + + rhead = rtail = 0; + for(p = str; *p; p = *pn ? pn + 1 : pn) { + s = strtoul(p,&pn,0); + if(pn > p) { + if(*pn == '-') { + p = pn + 1; + e = strtoul(p,&pn,0); + if(pn == p) e = s; + } else { + e = s; + } + + if(rtail) { + rtail->next = (id_table_range*)malloc(sizeof(id_table_range)); + rtail = rtail->next; + } else { + rhead = rtail = (id_table_range*)malloc(sizeof(id_table_range)); + } + rtail->start = s; + rtail->end = e; + } + } + if(rtail) rtail->next = 0; + return rhead; +} + +void id_table_range_delete(id_table_range *range) { + id_table_range *r; + while(r = range) { + range = range->next; + free(r); + } +} + +int id_table_init(id_table *t,id_table_range *range) { + id_table_range *r; + unsigned long array_end,u; + + if(!range) return -1; + t->array_start = range->start; + array_end = range->end; + for(r = range->next; r; r = r->next) { + if(r->start < t->array_start) t->array_start = r->start; + if(r->end > array_end) array_end = r->end; + } + if(t->array_start >= array_end) return -1; + t->array_size = array_end + 1 - t->array_start; + t->hash_size = t->array_size * 2 + 1; + t->key_hash_size = t->array_size * 2 + 1; + + t->array = (id_table_entry**)malloc(sizeof(id_table_entry*) * t->array_size); + t->hash = (id_table_entry**)malloc(sizeof(id_table_entry*) * t->hash_size); + t->key_hash = (key_hash_entry**)malloc(sizeof(key_hash_entry *) * t->key_hash_size); + if(!t->hash || !t->array || !t->key_hash) { + if(t->hash) free(t->hash); + if(t->key_hash) free(t->key_hash); + if(t->array) free(t->array); + return -1; + } + for(u = 0; u < t->array_size; u++) t->array[u] = (id_table_entry*)-1; + t->max_fill = 0; + for(r = range; r; r = r->next) { + t->max_fill += r->end + 1 - r->start; + for(u = r->start; u <= r->end; u++) t->array[u - t->array_start] = 0; + } + bzero(t->hash,sizeof(id_table_entry*) * t->hash_size); + bzero(t->key_hash, sizeof(key_hash_entry*) * t->key_hash_size); + + t->array_ptr = 0; + t->fill = 0; + return 0; +} + +void id_table_destroy(id_table *t) { + unsigned long u; + for(u = 0; u < t->array_size; u++) + if(t->array[u] && (t->array[u] != (id_table_entry*)-1)) free(t->array[u]); + free(t->hash); + free(t->array); +} + +int id_table_create_id(id_table *t,char *name,unsigned *key) { + id_table_entry **pe,*e; + unsigned long size; + + if(name && strlen(name)){ + for(pe = t->hash + hash_func(name,t->hash_size); *pe; pe = &(*pe)->next) + if(!strcmp(name,(*pe)->name)){ + if(key[0]){ + if((e = key_hash_get_entry(t, key)) == NULL){ + if(key_hash_create_entry(t, *pe, key) == NULL){ + return -1; + } + } + else if(e->id != (*pe)->id){ + return -1; + } + } + + return (*pe)->id; + } + + /* no matching name found */ + } + else { + if(e = key_hash_get_entry(t,key)) + return e->id; + + /* MUST have seen name/key pair at least once */ + errno = EINVAL; + return -1; + } + + /* need to add new entry */ + if(t->fill == t->max_fill) { + id_table_remove_stale(t); + if(t->fill == t->max_fill) { + errno = ENOSPC; + return -1; + } + for(pe = t->hash + hash_func(name,t->hash_size); *pe; pe = &(*pe)->next); + } + size = strlen(name); + e = (id_table_entry*)malloc(sizeof(id_table_entry) + size); + if(!e) return -1; + + while(t->array[t->array_ptr]) + t->array_ptr = (t->array_ptr + 1) % t->array_size; + + e->pself = pe; + e->next = 0; + e->id = (int)(t->array_ptr + t->array_start); + memcpy(e->name,name,size + 1); + if(key[0] && key_hash_create_entry(t, e,key) == NULL) + return -1; + + *pe = e; + t->array[t->array_ptr] = e; + t->array_ptr = (t->array_ptr + 1) % t->array_size; + t->fill++; + return e->id; +} + +static id_table_entry *id_table_get_entry(id_table *t,unsigned long id) { + if(id >= t->array_start) { + id -= t->array_start; + if(id < t->array_size) + if(t->array[id] && (t->array[id] != (id_table_entry*)-1)) + return t->array[id]; + } + return 0; +} + +char *id_table_get_name(id_table *t,int id) { + id_table_entry *e = id_table_get_entry(t,(unsigned long)id); + return e ? e->name : 0; +} + +int id_table_remove_stale(id_table *t) { + id_table_entry *e; + unsigned long u; + DIR *d; + struct dirent *de; + struct stat st; + char path[NAME_MAX + 7]; + + /* + * flag all uids inactive + */ + + for(u = 0; u < t->array_size; u++) + if(t->array[u] && (t->array[u] != (id_table_entry*)-1)) + t->array[u]->tmp = 0; + + /* + * go through list of processes, finding active uids + */ + + memcpy(path,"/proc/",6); + if(d = opendir("/proc")) { + while(de = readdir(d)) { + strcpy(path + 6,de->d_name); + if(!stat(path,&st)) { + if(e = id_table_get_entry(t,(unsigned long)st.st_uid)) e->tmp = 1; + } + } + closedir(d); + } + + /* + * remove ones still marked inactive + */ + + for(u = 0; u < t->array_size; u++) { + e = t->array[u]; + if(e && (e != (id_table_entry*)-1)) { + if(!e->tmp) { + if(e->next) e->next->pself = e->pself; + *e->pself = e->next; + t->array[u] = 0; + t->array_ptr = u; + t->fill--; + key_hash_delete_keys(t, e); + free(e); + } + } + } + return 0; +} + +id_table_entry *key_hash_get_entry(id_table *t, unsigned *key) { + key_hash_entry **ke; + + for(ke = t->key_hash + (key[0] % t->key_hash_size); *ke; ke = &(*ke)->next) + if(key[0] && (*ke)->key[0] == key[0] && !memcmp(key,(*ke)->key,WP_KEY_LEN * sizeof(unsigned))) + return (*ke)->e; + + return NULL; +} + +key_hash_entry *key_hash_create_entry(id_table *t, id_table_entry *pe, unsigned *key) { + key_hash_entry **ke, *kep; + + for(ke = &t->key_hash[key[0] % t->key_hash_size]; *ke; ke = &(*ke)->next) + if(!memcmp(key,(*ke)->key,WP_KEY_LEN * sizeof(unsigned))) + return NULL; + + if(kep = malloc(sizeof(key_hash_entry))){ + memcpy(kep->key,key,(WP_KEY_LEN * sizeof(unsigned int))); + kep->e = pe; + kep->pself = ke; + kep->next = NULL; + *ke = kep; + } + + return kep; +} + +void key_hash_delete_keys(id_table *t, id_table_entry *e) { + key_hash_entry *kp, *kd; + int u; + + for(u = 0; u < t->key_hash_size; u++){ + for(kp = t->key_hash[u]; kp; ) + if (kp->e == e){ + kd = kp; + if(kp->next) kp->next->pself = kp->pself; + *kp->pself = kp->next; + kp = kp->next; + free(kd); + } + else + kp = kp->next; + } +} diff --git a/web/src/pubcookie/id_table.h b/web/src/pubcookie/id_table.h new file mode 100644 index 00000000..2ba3f2b4 --- /dev/null +++ b/web/src/pubcookie/id_table.h @@ -0,0 +1,58 @@ +/* ======================================================================== + * Copyright 2006 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#ifndef _ID_TABLE_H_ +#define _ID_TABLE_H_ + +struct id_table_entry; +typedef struct id_table_entry id_table_entry; + +struct key_hash_entry; +typedef struct key_hash_entry key_hash_entry; + +typedef struct id_table_range { + unsigned long start; + unsigned long end; + struct id_table_range *next; +} id_table_range; + +typedef struct id_table { + id_table_entry **array; + unsigned long array_start; + unsigned long array_size; + unsigned long array_ptr; + + id_table_entry **hash; + unsigned long hash_size; + + key_hash_entry **key_hash; + unsigned long key_hash_size; + + unsigned long max_fill; + unsigned long fill; +} id_table; + +id_table_range *id_table_range_new(char *str); +void id_table_range_delete(id_table_range *range); + +int id_table_init(id_table *t,id_table_range *range); +void id_table_destroy(id_table *t); + +int id_table_create_id(id_table *t,char *name,unsigned int *key); +char *id_table_get_name(id_table *t,int id); +int id_table_remove_stale(id_table *t); + +id_table_entry *key_hash_get_entry(id_table *, unsigned *key); +key_hash_entry *key_hash_create_entry(id_table *, id_table_entry *pe, unsigned *key); +void key_hash_delete_keys(id_table *t, id_table_entry *e); + +#endif diff --git a/web/src/pubcookie/wp_gssapi_proxy.c b/web/src/pubcookie/wp_gssapi_proxy.c new file mode 100644 index 00000000..f23d6098 --- /dev/null +++ b/web/src/pubcookie/wp_gssapi_proxy.c @@ -0,0 +1,412 @@ +/* ======================================================================== + * Copyright 2006 University of Washington + * + * 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 + * + * ======================================================================== + */ + + +/* #define PROTOTYPE(x) x */ + +#include <system.h> +#include <general.h> + +#include "wp_uidmapper_lib.h" + +#include <gssapi/gssapi_generic.h> +#include <gssapi/gssapi_krb5.h> + +#define AUTH_GSS_PROXY_MESSAGE 1 +#define AUTH_GSS_PROXY_READ 2 +#define AUTH_GSS_PROXY_SUCCESS 3 +#define AUTH_GSS_PROXY_WRITE 4 +#define AUTH_GSS_PROXY_WRITE_NIL 5 + +#define AUTH_GSSAPI_P_NONE 1 +#define AUTH_GSSAPI_P_INTEGRITY 2 +#define AUTH_GSSAPI_P_PRIVACY 4 + +#ifdef NO_UIDMAPPER +int get_calling_username(int uid,char *name,int namelen) { + struct passwd *pw; + unsigned long len; + + pw = getpwuid(uid); + if(!pw) return -1; + len = strlen(pw->pw_name); + if(len >= namelen) len = namelen - 1; + memcpy(name,pw->pw_name,len); + name[len] = 0; + return len; +} +#else +#define get_calling_username wp_uidmapper_getname +#endif + +static unsigned long read_full(int fd,void *buf,unsigned long size) { + unsigned long total,s; + for(total = 0; total < size; total += s) { + s = read(fd,(char*)buf + total,size - total); + if(s == -1) { + if((errno == EAGAIN) || (errno == EINTR)) s = 0; + else return -1; + } else if(s == 0) break; + } + return total; +} + +static unsigned long write_full(int fd,void *buf,unsigned long size) { + unsigned long total,s; + for(total = 0; total < size; total += s) { + s = write(fd,(char*)buf + total,size - total); + if(s == -1) { + if((errno == EAGAIN) || (errno == EINTR)) s = 0; + else return -1; + } + } + return total; +} + +int cmd_message(char *str1, ...) { + va_list list; + unsigned long cmd[2],size; + char *str; + + for(size = 0,str = str1,va_start(list,str1); str; str = va_arg(list,char*)) + size += strlen(str); + va_end(list); + + cmd[0] = AUTH_GSS_PROXY_MESSAGE; + cmd[1] = size; + if(write_full(1,cmd,sizeof(cmd)) == -1) return -1; + for(str = str1, va_start(list,str1); str; str = va_arg(list,char*)) + if(size = strlen(str)) if(write_full(1,str,size) == -1) { + va_end(list); + return -1; + } + va_end(list); + return 0; +} + +int cmd_read(gss_buffer_desc *pbuf) { + unsigned long cmd[2],len,size; + void *buf; + + cmd[0] = AUTH_GSS_PROXY_READ; + cmd[1] = 0; + if(write_full(1,cmd,sizeof(cmd)) == -1) return -1; + + len = read_full(0,&size,sizeof(size)); + if(len != sizeof(size)) return -1; + if(size == 0) { + pbuf->value = 0; + pbuf->length = 0; + return 0; + } + + buf = malloc(size); + len = read_full(0,buf,size); + if(len != size) { + free(buf); + return -1; + } + pbuf->value = buf; + pbuf->length = size; + return 0; +} + +int cmd_success() { + unsigned long cmd[2]; + cmd[0] = AUTH_GSS_PROXY_SUCCESS; + cmd[1] = 0; + if(write_full(1,cmd,sizeof(cmd)) == -1) return -1; + return 0; +} + +int cmd_write(gss_buffer_desc *buf) { + unsigned long cmd[2]; + cmd[0] = AUTH_GSS_PROXY_WRITE; + cmd[1] = buf->length; + if(write_full(1,cmd,sizeof(cmd)) == -1) return -1; + if(buf->length) if(write_full(1,buf->value,buf->length) == -1) return -1; + return 0; +} + +int cmd_write_nil() { + unsigned long cmd[2]; + cmd[0] = AUTH_GSS_PROXY_WRITE_NIL; + cmd[1] = 0; + if(write_full(1,cmd,sizeof(cmd)) == -1) return -1; + return 0; +} + +/* + * service principal in argv[1] + * reqested username in argv[2] + */ + +int main(int argc,char *argv[]) +{ + char *user = 0; + char userbuf[WP_BUF_SIZE]; + char *prog; + OM_uint32 smj,smn,dsmn,mctx; + gss_name_t crname = GSS_C_NO_NAME; + gss_ctx_id_t ctx = GSS_C_NO_CONTEXT; + gss_buffer_desc chal,resp,buf; + int conf,i; + gss_qop_t qop; + gss_OID oid; + int calling_uid,eff_uid; + + if((prog = strrchr(argv[0], '/')) == NULL) + prog = argv[0]; + else + prog++; + + openlog(prog,LOG_PID,LOG_MAIL); + + calling_uid = getuid(); + eff_uid = geteuid(); +#ifdef DEBUG + syslog(LOG_INFO,"uid = %d, euid=%d\n",calling_uid,eff_uid); +#endif + +#ifdef WEBSERVER_UID + /* if euid != uid, change to web server user */ + if(calling_uid != eff_uid) if(setuid(WEBSERVER_UID)) { + syslog(LOG_ERR,"setuid ((%d != %d) -> %d) failed: %s", + calling_uid,eff_uid,WEBSERVER_UID,strerror(errno)); + cmd_write_nil(); + goto cleanup; + } +#endif + + if(argc < 2) { + syslog(LOG_WARNING,"not enough arguments"); + cmd_write_nil(); + goto cleanup; + } + if(get_calling_username(calling_uid,userbuf,WP_BUF_SIZE) == -1) { + syslog(LOG_WARNING,"cannot determine calling username"); + cmd_write_nil(); + goto cleanup; + } + if(argc == 2) { + user = userbuf; +#ifdef DEBUG + syslog(LOG_INFO,"calling=%s\n",user); +#endif + } else if(argc > 2) { + user = argv[2]; +#ifdef DEBUG + syslog(LOG_INFO,"requested=%s calling=%s\n",user,userbuf); +#endif +#ifndef NO_NAME_CHECK + if(strcmp(user,userbuf)) { + syslog(LOG_WARNING,"cannot act on behalf of user %s (%s)",user,userbuf); + cmd_write_nil(); + goto cleanup; + } +#endif + } + + /* expect empty challenge from server */ + if(cmd_read(&chal)) { + syslog(LOG_WARNING,"cmd_read[initial] failed"); + goto cleanup; + } else if(chal.length) { + free(chal.value); + syslog(LOG_WARNING,"cmd_read[initial] not empty"); + goto cleanup; + } + + /* + * obtain credentials for requested service + */ + + buf.value = argv[1]; + buf.length = strlen(argv[1]); + if(gss_import_name (&smn,&buf,gss_nt_service_name,&crname) != + GSS_S_COMPLETE) { + syslog(LOG_WARNING,"gss_import_name(%s) failed",buf.value); + cmd_write_nil(); + goto cleanup; + } + + /* initial init_sec_context call, and send data */ + memcpy(&oid,&gss_mech_krb5,sizeof(oid)); + smj = gss_init_sec_context + (&smn,GSS_C_NO_CREDENTIAL,&ctx,crname,oid, + GSS_C_MUTUAL_FLAG | GSS_C_REPLAY_FLAG,0,GSS_C_NO_CHANNEL_BINDINGS, + GSS_C_NO_BUFFER,0,&resp,0,0); + if((smj == GSS_S_COMPLETE) || (smj == GSS_S_CONTINUE_NEEDED)) { + i = cmd_write(&resp); + gss_release_buffer (&smn,&resp); + if(i) { + syslog(LOG_WARNING,"cmd_write[init_sec_context] failed"); + goto cleanup; + } + } + + /* loop until init_sec_context is done */ + while(smj == GSS_S_CONTINUE_NEEDED) { + if(cmd_read(&chal)) { + syslog(LOG_WARNING,"cmd_read[init_sec_context] failed"); + goto cleanup; + } else if(!chal.length) { + syslog(LOG_WARNING,"cmd_read[init_sec_context] empty"); + goto cleanup; + } else { + smj = gss_init_sec_context (&smn,GSS_C_NO_CREDENTIAL,&ctx,crname, + GSS_C_NO_OID, + GSS_C_MUTUAL_FLAG|GSS_C_REPLAY_FLAG,0, + GSS_C_NO_CHANNEL_BINDINGS,&chal,0, + &resp,0,0); + if(chal.value) free(chal.value); + if((smj == GSS_S_COMPLETE) || (smj == GSS_S_CONTINUE_NEEDED)) { + i = cmd_write(&resp); + gss_release_buffer (&smn,&resp); + if(i) { + syslog(LOG_WARNING,"cmd_write[init_sec_context] failed"); + goto cleanup; + } + } + } + } + + switch(smj) { + case GSS_S_COMPLETE: + /* get challenge and unwrap it */ + if(cmd_read(&chal)) { + syslog(LOG_WARNING,"cmd_read[gss_unwrap] failed"); + goto cleanup; + } + smj = gss_unwrap (&smn,ctx,&chal,&resp,&conf,&qop); + if(chal.value) free(chal.value); + if(smj != GSS_S_COMPLETE) { + syslog(LOG_WARNING,"gss_unwrap failed"); + cmd_write_nil(); + goto cleanup; + } else if(resp.length < 4) { + syslog(LOG_WARNING,"challenge too short"); + gss_release_buffer (&smn,&resp); + cmd_write_nil(); + goto cleanup; + } else if(!( ((char*)resp.value)[0] & AUTH_GSSAPI_P_NONE)) { + syslog(LOG_WARNING,"invalid challenge"); + gss_release_buffer (&smn,&resp); + cmd_write_nil(); + goto cleanup; + } + + /* prepare response to challenge */ + buf.length = 4 + (user ? strlen(user) : 0); + buf.value = malloc(buf.length); + memcpy (buf.value,resp.value,4); + gss_release_buffer (&smn,&resp); + *(char*)buf.value = AUTH_GSSAPI_P_NONE; + if(user) memcpy((char*)buf.value + 4, user, buf.length - 4); + + /* wrap response and send */ + smj = gss_wrap (&smn,ctx,0,qop,&buf,&conf,&resp); + free(buf.value); + if(smj != GSS_S_COMPLETE) { + syslog(LOG_WARNING,"gss_unwrap failed"); + cmd_write_nil(); + goto cleanup; + } + i = cmd_write(&resp); + gss_release_buffer (&smn,&resp); + if(i) { + syslog(LOG_WARNING,"cmd_write[gss_wrap] failed"); + goto cleanup; + } + + /* success! */ + if(cmd_success()) syslog(LOG_WARNING,"cmd_success failed"); + goto cleanup; + + case GSS_S_CREDENTIALS_EXPIRED: +#ifdef DEBUG + syslog(LOG_INFO,"Kerberos credentials expired (try running kinit)"); +#endif + if(cmd_message("Kerberos credentials expired (try running kinit)",0)) { + syslog(LOG_WARNING,"cmd_message[credentials expired] failed"); + goto cleanup; + } + cmd_write_nil(); + goto cleanup; + + case GSS_S_FAILURE: + if (smn == (OM_uint32) KRB5_FCC_NOFILE) { +#ifdef DEBUG + syslog(LOG_INFO,"No credentials cache found (try running kinit)"); +#endif + if(cmd_message("No credentials cache found (try running kinit)",0)) { + syslog(LOG_WARNING,"cmd_message[no cache file found] failed"); + goto cleanup; + } + } else { + mctx = 0; + do { + gss_display_status (&dsmn,smn,GSS_C_MECH_CODE, + GSS_C_NO_OID,&mctx,&resp); +#ifdef DEBUG + syslog(LOG_INFO,"GSSAPI failure: %s",resp.value); +#endif + i = cmd_message("GSSAPI failure: ",resp.value,0); + gss_release_buffer (&dsmn,&resp); + if(i) { + syslog(LOG_WARNING,"cmd_message[failure] failed"); + goto cleanup; + } + } while(mctx); + } + cmd_write_nil(); + goto cleanup; + + default: + mctx = 0; + do { + gss_display_status (&dsmn,smn,GSS_C_GSS_CODE, + GSS_C_NO_OID,&mctx,&resp); +#ifdef DEBUG + syslog(LOG_INFO,"GSSAPI failure: %s",resp.value); +#endif + i = cmd_message("Unknown GSSAPI failure: ",resp.value,0); + gss_release_buffer (&dsmn,&resp); + if(i) { + syslog(LOG_WARNING,"cmd_message[unknown failure] failed"); + goto cleanup; + } + } while(mctx); + if(!mctx) do { + gss_display_status (&dsmn,smn,GSS_C_MECH_CODE, + GSS_C_NO_OID,&mctx,&resp); +#ifdef DEBUG + syslog(LOG_INFO,"GSSAPI mechanism status: %s",resp.value); +#endif + i = cmd_message("GSSAPI mechanism status: ",resp.value,0); + gss_release_buffer (&dsmn,&resp); + if(i) { + syslog(LOG_WARNING,"cmd_message[unknown failure 2] failed"); + goto cleanup; + } + } while(mctx); + cmd_write_nil(); + goto cleanup; + } + + cleanup: + if(ctx != GSS_C_NO_CONTEXT) gss_delete_sec_context (&smn,&ctx,0); + if(crname != GSS_C_NO_NAME) gss_release_name (&smn,&crname); + closelog(); + exit(0); + return 0; +} diff --git a/web/src/pubcookie/wp_tclsh.c b/web/src/pubcookie/wp_tclsh.c new file mode 100644 index 00000000..e7fe14a7 --- /dev/null +++ b/web/src/pubcookie/wp_tclsh.c @@ -0,0 +1,189 @@ +/* + * tclAppInit.c -- + * + * Provides a default version of the main program and Tcl_AppInit + * procedure for Tcl applications (without Tk). + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclAppInit.c,v 1.4 1999/02/03 02:58:26 stanton Exp $ + */ + +/* ======================================================================== + * Copyright 2006 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#ifdef TCL_XT_TEST +#include <X11/Intrinsic.h> +#endif + +#include "tcl.h" + +/********** (start mihodge) *************************************/ +#include "wp_uidmapper_lib.h" +#include <errno.h> +#include <stdlib.h> /* getenv */ +/********** (end mihodge) *************************************/ + +/* + * The following variable is a special hack that is needed in order for + * Sun shared libraries to be used for Tcl. + */ + +extern int matherr(); +int *tclDummyMathPtr = (int *) matherr; + + +#ifdef TCL_TEST +extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); +extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +#endif /* TCL_TEST */ +#ifdef TCL_XT_TEST +extern int Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +#endif + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Tcl_Main never returns here, so this procedure never + * returns either. + * + * Side effects: + * Whatever the application does. + * + *---------------------------------------------------------------------- + */ + +int +main(argc, argv) + int argc; /* Number of command-line arguments. */ + char **argv; /* Values of command-line arguments. */ +{ + /********** PUBCOOKIE-Specific Inclusion **************************/ + char *user,sessid[WP_BUF_SIZE],*cookie; + int uid; + unsigned key[WP_KEY_LEN]; + + memset((void *) key, 0, sizeof(unsigned int) * WP_KEY_LEN); + sessid[0] = '\0'; + user = getenv("REMOTE_USER"); + if(!((((cookie = getenv("QUERY_STRING")) + && wp_parse_cookie(cookie,"sessid","&@% ",sessid,WP_BUF_SIZE)) + || ((cookie = getenv("HTTP_COOKIE")) + && wp_parse_cookie(cookie,"sessid",";@ ",sessid,WP_BUF_SIZE))) + && wp_sessid2key(sessid,key))) + cookie = NULL; + + if((getuid() == WEBSERVER_UID) && (user || cookie)){ + if(wp_uidmapper_getuid(user ? user : "",key,&uid) == -1) { + fprintf(stderr,"wp_uidmapper_getname(%s,%s) failed\n",user ? user : "",sessid); + return 1; + } else if(setuid(uid)) { + fprintf(stderr,"setuid(%i) failed: %s\n",uid,strerror(errno)); + return 1; + } + } else { + setuid(getuid()); + } + /********** (end PUBCOOKIE) *************************************/ + +#ifdef TCL_XT_TEST + XtToolkitInitialize(); +#endif + Tcl_Main(argc, argv, Tcl_AppInit); + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in interp->result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + if (Tcl_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + +#ifdef TCL_TEST +#ifdef TCL_XT_TEST + if (Tclxttest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } +#endif + if (Tcltest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, + (Tcl_PackageInitProc *) NULL); + if (TclObjTest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + if (Procbodytest_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init, + Procbodytest_SafeInit); +#endif /* TCL_TEST */ + + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ + + Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); + return TCL_OK; +} diff --git a/web/src/pubcookie/wp_uidmapper.c b/web/src/pubcookie/wp_uidmapper.c new file mode 100644 index 00000000..662e9b3a --- /dev/null +++ b/web/src/pubcookie/wp_uidmapper.c @@ -0,0 +1,312 @@ +/* ======================================================================== + * Copyright 2006 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "id_table.h" +#include "wp_uidmapper_lib.h" + + +/* Makefile should #define: + * + * WP_UIDMAPPER_SOCKET + */ + +unsigned long send_full(int fd,void *buf,unsigned long len,int flags) { + unsigned long total,i; + for(total = 0; total < len; total += i) { + i = send(fd,(char*)buf + total, len - total,flags); + if(i == -1) return -1; + } + return total; +} + +static char *socketname = WP_UIDMAPPER_SOCKET; +static int socketname_remove = 0; + +void socketname_cleanup(void) { + unlink(socketname); +} + +void quit_handler(int signal) { + exit(signal); +} + +int main(int argc, char *argv[]) { + extern char *optarg; + extern int optind, opterr, optopt; + + int debug,log_opt; + mode_t sockmode; + + id_table_range *range; + id_table table; + struct sockaddr_un sun,rsun; + struct sigaction sa; + int is_err,i,ssock,uid; + unsigned int kbuf[WP_KEY_LEN]; + char rbuf[WP_BUF_SIZE],cbuf[WP_BUF_SIZE],rcmd; + struct msghdr rmh,smh; + struct iovec riov[3],siov[1]; +#ifndef DGRAM_MODE + int csock,rsun_len; +#endif + struct ucred cred; + + /* + * process command line arguments + */ + + debug = 0; + log_opt = 0; + sockmode = 0600; + + for(is_err = 0; !is_err && ((i = getopt(argc,argv,"dlrm:s:u:")) != -1); ) { + switch(i) { + case 'd': debug++; break; + case 'l': log_opt |= LOG_PERROR; break; + case 'm': sockmode = strtol(optarg,NULL,0); break; + case 'r': socketname_remove = 1; break; + case 's': socketname = optarg; break; + case 'u': umask(strtol(optarg,NULL,0)); break; + case '?': is_err = 1; break; + } + } + if((optind + 1) == argc) { + range = id_table_range_new(argv[optind]); + if(!range) is_err = 1; + } else { + is_err = 1; + } + if(is_err) { + fprintf(stderr,"Usage: uidmapper [-d] [-l] [-r] [-m mode] [-s socketname] [-u umask] uidranges\n"); + exit(1); + } + + /* + * main initialization + */ + + openlog(argv[0],log_opt,LOG_MAIL); + + if(id_table_init(&table,range)) { + syslog(LOG_ERR,"could not initialize tables: %s\n",strerror(errno)); + exit(1); + } + id_table_range_delete(range); + + sa.sa_handler = quit_handler; + sigemptyset(&sa.sa_mask); + sa.sa_flags = 0; + sigaction(SIGHUP,&sa,0); + sigaction(SIGINT,&sa,0); + sigaction(SIGQUIT,&sa,0); + sigaction(SIGTERM,&sa,0); + + if(socketname_remove) + socketname_cleanup(); + + /* + * open socket + */ + +#ifdef DGRAM_MODE + ssock = socket(AF_UNIX,SOCK_DGRAM,0); +#else + ssock = socket(AF_UNIX,SOCK_STREAM,0); +#endif + if(ssock < 0) { + syslog(LOG_ERR,"%s: socket: %s\n",socketname,strerror(errno)); + exit(1); + } + /* sun.sun_len = strlen(socketname) + 1; */ + sun.sun_family = AF_UNIX; + strcpy(sun.sun_path,socketname); + if(bind(ssock,(struct sockaddr*)&sun,sizeof(sun))) { + syslog(LOG_ERR,"%s: bind: %s\n",socketname,strerror(errno)); + exit(1); + } + atexit(socketname_cleanup); + chmod(ssock,sockmode); + +#ifndef DGRAM_MODE + if(listen(ssock,8)) { + syslog(LOG_ERR,"%s: listen: %s\n",socketname,strerror(errno)); + exit(1); + } +#endif + +#ifdef DGRAM_MODE + if(debug >= 1) syslog(LOG_INFO,"SOCK_DGRAM socket opened"); +#else + if(debug >= 1) syslog(LOG_INFO,"SOCK_STREAM socket opened"); +#endif + + /* + * accept commands + */ + + riov[0].iov_base = &rcmd; + riov[0].iov_len = 1; + riov[1].iov_base = kbuf; + riov[1].iov_len = WP_KEY_LEN * sizeof(unsigned int); + riov[2].iov_base = rbuf; + riov[2].iov_len = WP_BUF_SIZE - 1; + rmh.msg_name = &rsun; + rmh.msg_namelen = sizeof(rsun); + rmh.msg_iov = riov; + rmh.msg_iovlen = 3; + rmh.msg_control = cbuf; + rmh.msg_controllen = riov[0].iov_len + riov[1].iov_len + riov[2].iov_len; + rmh.msg_flags = 0; + + /* siov[0].iov_base */ + /* siov[0].iov_len */ + smh.msg_name = NULL; + smh.msg_namelen = 0; + smh.msg_iov = siov; + /* smh.msg_iovlen */ + smh.msg_control = NULL; + smh.msg_controllen = 0; + smh.msg_flags = 0; + +#ifndef DGRAM_MODE + csock = -1; +#endif + + while(1) { +#ifdef DGRAM_MODE + i = recvmsg(ssock,&rmh,0); +#else + if(csock >= 0) close(csock); + rsun.sun_family = AF_UNIX; + rsun_len = sizeof(rsun); + csock = accept(ssock,(struct sockaddr*)&rsun,&rsun_len); + if(csock == -1) { + syslog(LOG_ERR,"accept: %s\n",strerror(errno)); + break; + } + if(debug >= 2) { + i = sizeof(cred); + if(getsockopt(csock,SOL_SOCKET,SO_PEERCRED,&cred,&i) == -1) { + syslog(LOG_INFO,"getsockopt(SO_PEERCRED) failed: %s",strerror(errno)); + } else { + syslog(LOG_INFO,"connection from pid=%i uid=%i gid=%i\n", + cred.pid,cred.uid,cred.gid); + } + } + i = recvmsg(csock,&rmh,0); +#endif + + if(i == -1) { + syslog(LOG_ERR,"recvmsg: %s\n",strerror(errno)); + break; + } + if(debug >= 2) + syslog(LOG_INFO,"recvd datagram [size=%i] from %s [size=%i]\n", + i,rsun.sun_path,rmh.msg_namelen); + + /* check that datagram is well formed */ + if(i < 1) { + syslog(LOG_WARNING,"recv: recvd datagram that is too small\n"); + continue; + } + i--; +#ifdef DGRAM_MODE + smh.msg_name = rmh.msg_name; + smh.msg_namelen = rmh.msg_namelen; +#endif + + if(rcmd == 'u') { + if(!i) { + syslog(LOG_WARNING,"recv: recvd 'u' datagram with no payload\n"); + continue; + } + rbuf[i - (WP_KEY_LEN * sizeof(unsigned int))] = 0; + uid = id_table_create_id(&table,rbuf,kbuf); + if(debug >= 1) syslog(LOG_INFO,"request uid(%s) = %i\n",rbuf,uid); + if(uid == -1) { + char sbuf[2 * WP_BUF_SIZE],*sep = strerror(errno); + sprintf(sbuf,"id_table_create_id(%s,[",rbuf); + for(i = 0; i < WP_KEY_LEN; i++) + sprintf(sbuf + strlen(sbuf), "%u,", kbuf[i]); + + sprintf(sbuf + strlen(sbuf) - 1, "]): %s\n",sep); + syslog(LOG_ERR,sbuf); + /* break; hobble along rather than die */ + } + + siov[0].iov_base = &uid; + siov[0].iov_len = sizeof(uid); + smh.msg_iovlen = 1; +#ifdef DGRAM_MODE + if(sendmsg(ssock,&smh,0) == -1) +#else + if(sendmsg(csock,&smh,0) == -1) +#endif + syslog(LOG_WARNING,"sendmsg: %s\n",strerror(errno)); + + } else if(rcmd == 'n') { + if(i != sizeof(uid)) { + syslog(LOG_WARNING,"recv: recvd 'n' datagram with invalid payload\n"); + continue; + } + + memcpy(&uid,kbuf,sizeof(uid)); + siov[0].iov_base = id_table_get_name(&table,uid); + if(debug >= 1) + syslog(LOG_INFO,"request name(%d) = %s\n",uid,siov[0].iov_base); + + if(siov[0].iov_base) { + siov[0].iov_len = strlen(siov[0].iov_base); + smh.msg_iovlen = 1; + } else { + smh.msg_iovlen = 0; + } +#ifdef DGRAM_MODE + if(sendmsg(ssock,&smh,0) == -1) +#else + if(sendmsg(csock,&smh,0) == -1) +#endif + syslog(LOG_WARNING,"sendmsg: %s\n",strerror(errno)); + + } else if(rcmd == 'c') { + if(debug >= 1) syslog(LOG_INFO,"request clear()"); + if(id_table_remove_stale(&table)) { + syslog(LOG_WARNING,"id_table_remove_stale: %s\n",strerror(errno)); + break; + } + } +#ifdef HONOR_QUIT + else if(rcmd == 'q') { + if(debug >= 1) syslog(LOG_INFO,"quit requested"); + break; + } +#endif + else { + syslog(LOG_WARNING,"invalid request received"); + } + } +#ifndef DGRAM_MODE + if(csock >= 0) close(csock); +#endif + + /* + * clean up (never really get this far) + */ + + id_table_destroy(&table); + close(ssock); + exit(0); + return 0; +} diff --git a/web/src/pubcookie/wp_uidmapper_lib.c b/web/src/pubcookie/wp_uidmapper_lib.c new file mode 100644 index 00000000..ddaf5175 --- /dev/null +++ b/web/src/pubcookie/wp_uidmapper_lib.c @@ -0,0 +1,178 @@ +/* ======================================================================== + * Copyright 2006 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "wp_uidmapper_lib.h" + + +static char *xdigits = "0123456789ABCDEF"; + +static int do_handshake(char *sockname, + struct iovec *out,int outlen,int *routbytes, + struct iovec *in,int inlen,int *rinbytes) { + int sock,i; + struct msghdr mh; + struct sockaddr_un sun; + +#ifdef DGRAM_MODE + sock = socket(AF_UNIX,SOCK_DGRAM,0); +#else + sock = socket(AF_UNIX,SOCK_STREAM,0); +#endif + if(sock < 0) return -1; + + sun.sun_family = AF_UNIX; + strcpy(sun.sun_path,sockname); + if(connect(sock,(struct sockaddr*)&sun,sizeof(sun))) return -1; + + mh.msg_name = NULL; + mh.msg_namelen = 0; + mh.msg_iov = out; + mh.msg_iovlen = outlen; + mh.msg_control = NULL; + mh.msg_controllen = 0; + mh.msg_flags = 0; + + if((i = sendmsg(sock,&mh,0)) == -1) { + close(sock); + return -1; + } + if(routbytes) *routbytes = i; + + if(in) { + mh.msg_iov = in; + mh.msg_iovlen = inlen; + mh.msg_flags = 0; + if((i = recvmsg(sock,&mh,0)) == -1) { + close(sock); + return -1; + } + if(rinbytes) *rinbytes = i; + } + close(sock); + return 0; +} + +int wp_uidmapper_getuid(char *name,unsigned int *key,int *puid) { + int uid,outbytes,inbytes; + char cmd; + struct iovec out[3],in[1]; + + cmd = 'u'; + out[0].iov_base = &cmd; + out[0].iov_len = 1; + out[1].iov_base = key; + out[1].iov_len = WP_KEY_LEN * sizeof(unsigned int); + out[2].iov_base = name ? name : ""; + out[2].iov_len = name ? strlen(name) : 0; + in[0].iov_base = &uid; + in[0].iov_len = sizeof(uid); + + if(do_handshake(WP_UIDMAPPER_SOCKET,out,3,&outbytes,in,1,&inbytes)) + return -1; + if((outbytes != (1 + out[1].iov_len) + out[2].iov_len) || (inbytes != in[0].iov_len)) + return -1; + *puid = uid; + return 0; +} + +int wp_uidmapper_getname(int uid,char *name,int namelen) { + int outbytes,inbytes; + char cmd; + struct iovec out[2],in[1]; + + cmd = 'n'; + out[0].iov_base = &cmd; + out[0].iov_len = 1; + out[1].iov_base = &uid; + out[1].iov_len = sizeof(uid); + in[0].iov_base = name; + in[0].iov_len = namelen - 1; + + if(do_handshake(WP_UIDMAPPER_SOCKET,out,2,&outbytes,in,1,&inbytes)) + return -1; + if(outbytes != (1 + out[1].iov_len)) return -1; + name[inbytes] = 0; + return 0; +} + +int wp_uidmapper_clear() { + int outbytes; + char cmd; + struct iovec out[1]; + + cmd = 'c'; + out[0].iov_base = &cmd; + out[0].iov_len = 1; + + if(do_handshake(WP_UIDMAPPER_SOCKET,out,1,&outbytes,NULL,0,NULL)) return -1; + if(outbytes != 1) return -1; + return 0; +} + +int wp_uidmapper_quit() { + int outbytes; + char cmd; + struct iovec out[1]; + + cmd = 'q'; + out[0].iov_base = &cmd; + out[0].iov_len = 1; + + if(do_handshake(WP_UIDMAPPER_SOCKET,out,1,&outbytes,NULL,0,NULL)) return -1; + if(outbytes != 1) return -1; + return 0; +} + +int wp_sessid2key(char *ids,unsigned int *ida) { + int i, j, k; + unsigned int n; + char *p; + + i = j = 0; + while(1){ + n = 0; + for(k = 0; k < 8; k++) + if((p = strchr(xdigits, toupper((int) ids[j++]))) != NULL) + n = (n << 4) | (p - xdigits); + else + return(0); + + ida[i] = n; + if(++i == WP_KEY_LEN) + return(ids[j] == '\0'); + else if(ids[j++] != '.') + return(0); + } +} + +int wp_parse_cookie (char *cookie,char *cname,char *terms,char *cvalue,int vmax) { + char *p, *q; + int i; + + if((p = strstr(cookie, cname)) != NULL){ + p += strlen(cname) + 1; /* skip cname and equals */ + q = cvalue; + while(*p && !strchr(terms, *p)){ + *q++ = *p++; + if((q - cvalue) >= vmax) + return(0); + } + + *q = '\0'; + return(1); + } + + return(0); +} diff --git a/web/src/pubcookie/wp_uidmapper_lib.h b/web/src/pubcookie/wp_uidmapper_lib.h new file mode 100644 index 00000000..e1832454 --- /dev/null +++ b/web/src/pubcookie/wp_uidmapper_lib.h @@ -0,0 +1,25 @@ +/* ======================================================================== + * Copyright 2006 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#ifndef _WP_UIDMAPPER_LIB_H_ +#define _WP_UIDMAPPER_LIB_H_ + +int wp_uidmapper_getuid(char *name,unsigned int *key,int *puid); +int wp_uidmapper_getname(int uid,char *name,int namelen); +int wp_uidmapper_clear(); +int wp_uidmapper_quit(); +int wp_sessid2key(char *ids,unsigned int *ida); + +#define WP_BUF_SIZE 1024 +#define WP_KEY_LEN 6 + +#endif diff --git a/web/src/pubcookie/wp_umc.c b/web/src/pubcookie/wp_umc.c new file mode 100644 index 00000000..a55d2127 --- /dev/null +++ b/web/src/pubcookie/wp_umc.c @@ -0,0 +1,63 @@ +/* ======================================================================== + * Copyright 2006 University of Washington + * + * 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 + * + * ======================================================================== + */ + +#include <system.h> +#include <general.h> + +#include "wp_uidmapper_lib.h" + + +int main(int argc,char *argv[]) { + char name[WP_BUF_SIZE],sessid[WP_BUF_SIZE]; + int uid,i,key[WP_KEY_LEN]; + + if(argc >= 2) { + if(*argv[1] == 'u') { + if(argc >= 3) { + memset(key,0,WP_KEY_LEN * sizeof(int)); + if(argc >= 4){ + if(wp_parse_cookie(argv[3],"sessid",";@",sessid,WP_BUF_SIZE)) + (void)wp_sessid2key(sessid,key); + } + + if(wp_uidmapper_getuid((argv[2][0] == '\0') ? NULL : argv[2],key,&uid) != -1) { + printf("uid = %i\n",uid); + return 0; + } else fprintf(stderr,"wp_uidmapper_getuid error: %s\n", + strerror(errno)); + } + } else if(*argv[1] == 'n') { + if(argc >= 3) { + i = wp_uidmapper_getname(strtol(argv[2],NULL,0),name,WP_BUF_SIZE); + if(i != -1) { + printf("name = %s\n",name); + return 0; + } else fprintf(stderr,"wp_uidmapper_getname error: %s\n", + strerror(errno)); + } + } else if(*argv[1] == 'c') { + if(wp_uidmapper_clear() != -1) { + printf("clear command sent\n"); + return 0; + } else fprintf(stderr,"wp_uidmapper_clear error: %s\n", + strerror(errno)); + } else if(*argv[1] == 'q') { + if(wp_uidmapper_quit() != -1) { + printf("quit command sent\n"); + return 0; + } else fprintf(stderr,"wp_uidmapper_quit error: %s\n", + strerror(errno)); + } + } + fprintf(stderr,"Usage: wp_umc [u name [key] ] [n uid] [c] [q]\n"); + return -1; +} |