1/*
2 * crypt.c --
3 *
4 *	Implements the 'crypt' and 'md5crypt' commands.
5 *
6 *
7 * Copyright (c) 1996 Andreas Kupries (a.kupries@westend.com)
8 * All rights reserved.
9 *
10 * Permission is hereby granted, without written agreement and without
11 * license or royalty fees, to use, copy, modify, and distribute this
12 * software and its documentation for any purpose, provided that the
13 * above copyright notice and the following two paragraphs appear in
14 * all copies of this software.
15 *
16 * IN NO EVENT SHALL I LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL,
17 * INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS
18 * SOFTWARE AND ITS DOCUMENTATION, EVEN IF I HAVE BEEN ADVISED OF THE
19 * POSSIBILITY OF SUCH DAMAGE.
20 *
21 * I SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
22 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
23 * PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
24 * I HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
25 * ENHANCEMENTS, OR MODIFICATIONS.
26 *
27 * CVS: $Id: crypt.c,v 1.7 2000/11/18 22:42:31 aku Exp $
28 */
29
30#include "loadman.h"
31
32static int
33TrfCryptObjCmd _ANSI_ARGS_ ((ClientData notUsed, Tcl_Interp* interp,
34			     int objc, struct Tcl_Obj* CONST * objv));
35static int
36TrfMd5CryptObjCmd _ANSI_ARGS_ ((ClientData notUsed, Tcl_Interp* interp,
37				int objc, struct Tcl_Obj* CONST * objv));
38
39/*
40 *----------------------------------------------------------------------
41 *
42 * TrfCryptObjCmd --
43 *
44 *	This procedure is invoked to process the "crypt" Tcl command.
45 *	See the user documentation for details on what it does.
46 *
47 * Results:
48 *	A standard Tcl result.
49 *
50 * Side effects:
51 *	None.
52 *
53 *----------------------------------------------------------------------
54 */
55
56static int
57TrfCryptObjCmd (notUsed, interp, objc, objv)
58     ClientData  notUsed;		/* Not used. */
59     Tcl_Interp* interp;		/* Current interpreter. */
60     int                     objc;	/* Number of arguments. */
61     struct Tcl_Obj* CONST * objv;	/* Argument strings. */
62{
63  /*
64   * crypt <passwd> <salt>
65   */
66
67#ifdef __WIN32__
68  Tcl_SetObjResult (interp, Tcl_NewStringObj ("crypt is not available under Windows", -1));
69  return TCL_ERROR;
70#else
71  const char* passwd;
72  const char* salt;
73  Tcl_Obj*    res;
74
75  if (objc != 3) {
76    Tcl_AppendResult (interp,
77		      "wrong # args: should be \"crypt passwd salt\"",
78		      (char*) NULL);
79    return TCL_ERROR;
80  }
81
82  passwd = Tcl_GetStringFromObj (objv [1], NULL);
83  salt   = Tcl_GetStringFromObj (objv [2], NULL);
84
85  /* THREADING: Serialize access to result string of 'crypt'.
86   */
87
88  TrfLock;
89  res = Tcl_NewStringObj ((char*) crypt (passwd, salt), -1);
90  TrfUnlock;
91
92  Tcl_SetObjResult (interp, res);
93  return TCL_OK;
94#endif
95}
96
97/*
98 *----------------------------------------------------------------------
99 *
100 * TrfMd5CryptObjCmd --
101 *
102 *	This procedure is invoked to process the "md5crypt" Tcl command.
103 *	See the user documentation for details on what it does.
104 *
105 * Results:
106 *	A standard Tcl result.
107 *
108 * Side effects:
109 *	Unstacks the channel, thereby restoring its parent.
110 *
111 *----------------------------------------------------------------------
112 */
113
114static int
115TrfMd5CryptObjCmd (notUsed, interp, objc, objv)
116     ClientData  notUsed;		/* Not used. */
117     Tcl_Interp* interp;		/* Current interpreter. */
118     int                     objc;	/* Number of arguments. */
119     struct Tcl_Obj* CONST * objv;	/* Argument strings. */
120{
121  /*
122   * md5crypt <passwd> <salt>
123   */
124
125  const char* passwd;
126  const char* salt;
127  char        salt_b [6];
128  Tcl_Obj*    res;
129
130  if (TrfLoadMD5 (interp) != TCL_OK) {
131    return TCL_ERROR;
132  }
133
134  if (objc != 3) {
135    Tcl_AppendResult (interp,
136		      "wrong # args: should be \"md5crypt passwd salt\"",
137		      (char*) NULL);
138    return TCL_ERROR;
139  }
140
141  passwd = Tcl_GetStringFromObj (objv [1], NULL);
142  salt   = Tcl_GetStringFromObj (objv [2], NULL);
143
144  /*
145   * Manipulate salt, add magic md5 prefix '$1$'.
146   * The 'crypt +3' later on skips the first three characters of the result,
147   * which again contain the magic marker.
148   */
149
150  salt_b [0] = '$';
151  salt_b [1] = '1';
152  salt_b [2] = '$';
153  salt_b [3] = salt [0];
154  salt_b [4] = salt [1];
155  salt_b [5] = '\0';
156
157  /* THREADING: Serialize access to result string of 'md5f.crypt'.
158   */
159
160  TrfLock;
161  res = Tcl_NewStringObj ((char*) md5f.crypt (passwd, salt_b) + 3, -1);
162  TrfUnlock;
163
164  Tcl_SetObjResult (interp, res);
165  return TCL_OK;
166}
167
168/*
169 *------------------------------------------------------*
170 *
171 *	TrfInit_Crypt --
172 *
173 *	------------------------------------------------*
174 *	Register the 'crypt' and 'md5crypt' commands.
175 *	------------------------------------------------*
176 *
177 *	Sideeffects:
178 *		As of 'Tcl_CreateObjCommand'.
179 *
180 *	Result:
181 *		A standard Tcl error code.
182 *
183 *------------------------------------------------------*
184 */
185
186int
187TrfInit_Crypt (interp)
188Tcl_Interp* interp;
189{
190  Tcl_CreateObjCommand (interp, "crypt", TrfCryptObjCmd,
191			(ClientData) NULL,
192			(Tcl_CmdDeleteProc *) NULL);
193
194  Tcl_CreateObjCommand (interp, "md5crypt", TrfMd5CryptObjCmd,
195			(ClientData) NULL,
196			(Tcl_CmdDeleteProc *) NULL);
197
198  return TCL_OK;
199}
200
201