hMailServer-Konfiguration via CGI

Es ist endlich geschafft! Nachdem ich die letzten Tage überlegt habe, wie ich das ganze am unkompliziertesten löse, habe ich nun eine Möglichkeit gefunden: Die Rede ist von der Verwaltung eines hMailServer Mailaccounts.

In den letzten Tagen hatte ich euch VBScripte vorgestellt, mit denen ein Benutzer sein Passwort ändern oder eine Mailumleitung einrichten kann. Das Problem bestand bisher darin, diese Funktionen auch remote verfügbar zu machen - denn direkten Zugriff auf den Server wird keiner der Mailbenutzer kriegen. 😉

Im Moment verwende ich immernoch einen ziemlich minimalistischen Webserver auf dem Rechner - trotzdem wollte ich die Konfiguration bereits lauffähig machen. Die einzige Möglichkeit hierfür war die Verwendung eines CGI-Scriptes.
Also habe ich mich auf die Suche gemacht, wie ich ein VBScript über CGI ansprechen und ausführen kein. Dummerweise funktionierte das Codebeispiel bei mir überhaupt nicht! Eine andere Lösung musste also her...

...und diese habe ich hier gefunden. Anstatt eines CGI-Scriptes habe ich einfach eine CGI-Anwendung in Delphi geschrieben 😀 ! Dadurch habe ich zum einen gelernt, wie man sowas macht und zum anderen konnte ich das ganze in einer robusten, mir bekannten Sprache erstellen.

Wo ihr ein bisschen aufpassen müsst, ist bei dem Herleiten der Dateipfade: Irgendwie habe ich da das Gefühl, dass der Server die Werte PATH_INFO, PATH_TRANSLATED und SCRIPT_NAME nicht korrekt setzt. Aber das müsste man nochmal durch das Testen mit anderen Webservern überprüfen.

Hier jedenfalls erstmal der Quelltext:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
unit MainForm;

interface

uses
  Windows,
  SysUtils,
  Messages,
  HTTPApp,
  Classes;


type
  TValueAction = (vaUnknown, vaForward, vaPassword);

  TValueRecord = record
    Action         : TValueAction;
    Domain         : String;
    Username       : String;
    Password       : String;
    ForwardAddress : String;
    NewPassword    : String;
  end;

  TMainWebModule = class(TWebModule)
    procedure MainWebModuledefaultAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private-Deklarationen }
    function GetApplicationOutput(AApplication : String; AParameters : TStringList) : String;
    function GetCGIPath(APathTranslated : String; APathInfo : String; AScriptName : String) : String;
    function GetResultString(AAction : TValueAction; AResult : String) : String;
    function GetWindowsPath : String;
    function ParseRequest(ARequest : TWebRequest) : TValueRecord;
  public
    { Public-Deklarationen }
  end;

var
  MainWebModule : TMainWebModule;

implementation

{$R *.xfm}

const
  CCGIFolder       = '/cgi-bin';
  CCscriptExe      = 'system32\cscript.exe';
  CForwardAction   = 'forward';
  CForwardParam    = 'forward';
  CForwardVBS      = 'changeForward.vbs';
  CNewParam        = 'new';
  CNoLogoParam     = '/nologo';
  CPasswordAction  = 'password';
  CPasswordParam   = 'password';
  CPasswordVBS     = 'changePassword.vbs';
  CPathDivider     = '\';
  CQuote           = '"';
  CQuoteEscaped    = '"';
  CURLDivider      = '/';

// source: http://delphi.about.com/cs/adptips2001/a/bltip0201_2.htm
function TMainWebModule.GetApplicationOutput(AApplication: String; AParameters: TStringList): String;
  function GetParameterLine(AApplication : String; AParameters : TStringList) : String;
  var
    LIndex : Integer;
  begin
    Result := CQuote + StringReplace(AApplication, CQuote, CQuoteEscaped, [rfReplaceAll, rfIgnoreCase]) + CQuote;

    if (AParameters <> nil) then
    begin
      for LIndex := 0 to Pred(AParameters.Count) do
        Result := Result + #32 + CQuote + StringReplace(AParameters[LIndex], CQuote, CQuoteEscaped, [rfReplaceAll, rfIgnoreCase]) + CQuote;
    end;
  end;

  procedure ProcessMessages;
  var
    LMessage : TMsg;
  begin
    while PeekMessage(LMessage, 0, 0, 0, PM_REMOVE) do
    begin
      if (LMessage.Message <> WM_QUIT) then
      begin
        TranslateMessage(LMessage);
        DispatchMessage(LMessage);
      end
      else
        Break;
    end;
  end;
const
  CReadBuffer = 1024;
var
  LAppRunning  : DWord;
  LBuffer      : PChar;
  LBytesRead   : DWord;
  LProcessInfo : TProcessInformation;
  LReadPipe    : THandle;
  LSecurity    : TSecurityAttributes;
  LStart       : TStartUpInfo;
  LWritePipe   : THandle;
begin
  Result := '';

  LSecurity.nLength             := SizeOf(TSecurityAttributes);
  LSecurity.bInheritHandle      := true;
  LSecurity.lpSecurityDescriptor := nil;

  if CreatePipe(LReadPipe, LWritePipe, @LSecurity, 0) then
  begin
    try
      LBuffer := AllocMem(Succ(CReadBuffer));
      try
        FillChar(LStart, SizeOf(LStart), #0) ;
        LStart.cb          := SizeOf(LStart) ;
        LStart.dwFlags     := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        LStart.hStdInput   := LReadPipe;
        LStart.hStdOutput  := LWritePipe;
        LStart.wShowWindow := SW_HIDE;

        if CreateProcess(nil, PChar(GetParameterLine(AApplication, AParameters)),
                         @LSecurity, @LSecurity, true, NORMAL_PRIORITY_CLASS, nil,
                         nil, LStart, LProcessInfo) then
        begin
          try
            repeat
              LAppRunning := WaitForSingleObject(LProcessInfo.hProcess, 100);

              ProcessMessages;
            until (LAppRunning <> WAIT_TIMEOUT);

            repeat
              LBytesRead := 0;
              ReadFile(LReadPipe, LBuffer[0], CReadBuffer, LBytesRead, nil) ;
              LBuffer[LBytesRead] := #0;
              OemToChar(LBuffer, LBuffer);

              Result := Result + String(LBuffer);
            until (LBytesRead < CReadBuffer);
          finally
            CloseHandle(LProcessInfo.hProcess);
            CloseHandle(LProcessInfo.hThread);
          end;
        end;
      finally
        FreeMem(LBuffer);
      end;
    finally
      CloseHandle(LReadPipe);
      CloseHandle(LWritePipe);
    end;
  end;
end;

function TMainWebModule.GetCGIPath(APathTranslated, APathInfo, AScriptName: String): String;
var
  LPosition : Integer;
begin
  Result := '';

  repeat
    LPosition := Pos(CURLDivider, APathInfo);
    if (LPosition > 0) then
      APathInfo[LPosition] := CPathDivider;
  until (LPosition <= 0);

  repeat
    LPosition := Pos(CURLDivider, AScriptName);
    if (LPosition > 0) then
      AScriptName[LPosition] := CPathDivider;
  until (LPosition <= 0);

  if (Pred(Pos(APathInfo, AScriptName) + Length(APathInfo)) = Length(AScriptName)) then
  begin
    Delete(AScriptName, Succ(Length(AScriptName) - Length(APathInfo)), Length(APathInfo));

    if (Pred(Pos(APathInfo, APathTranslated) + Length(APathInfo)) = Length(APathTranslated)) then
    begin
      Delete(APathTranslated, Succ(Length(APathTranslated) - Length(APathInfo)), Length(APathInfo));

      Result := APathTranslated + AScriptName + CPathDivider;
    end;
  end;
end;

function TMainWebModule.GetResultString(AAction: TValueAction; AResult: String) : String;
const
  CEverythingFine   = 'everything went fine';
  CForward          = '(forward)';
  CInternalError    = 'an internal error occured';
  CMissingArguments = 'missing arguments';
  CNoSuchDomain     = 'there is no such domain';
  CPassword         = '(password)';
  CUnknownError     = 'an unknown error occured';
  CWrongCredentials = 'wrong credentials have been provided';
var
  LError  : LongInt;
  LResult : Byte;
begin
  Result := '';

  AResult := Trim(AResult);
  Val(AResult, LResult, LError);
  if (LError = 0) then
  begin
    case AAction of
      vaForward :
      begin
        case LResult of
          0 : Result := AResult + #32 + CEverythingFine + #32 + CForward;
          1 : Result := AResult + #32 + CWrongCredentials + #32 + CForward;
          2 : Result := AResult + #32 + CWrongCredentials + #32 + CForward;
          3 : Result := AResult + #32 + CNoSuchDomain + #32 + CForward;
          4 : Result := AResult + #32 + CWrongCredentials + #32 + CForward;
          5 : Result := AResult + #32 + CInternalError + #32 + CForward;
          6 : Result := AResult + #32 + CMissingArguments + #32 + CForward;
        else
          Result := AResult + #32 + CUnknownError + #32 + CForward;
        end;
      end;

      vaPassword :
      begin
        case LResult of
          0 : Result := AResult + #32 + CEverythingFine + #32 + CPassword;
          1 : Result := AResult + #32 + CWrongCredentials + #32 + CPassword;
          2 : Result := AResult + #32 + CWrongCredentials + #32 + CPassword;
          3 : Result := AResult + #32 + CNoSuchDomain + #32 + CPassword;
          4 : Result := AResult + #32 + CWrongCredentials + #32 + CPassword;
          5 : Result := AResult + #32 + CInternalError + #32 + CPassword;
          6 : Result := AResult + #32 + CMissingArguments + #32 + CPassword;
        else
          Result := AResult + #32 + CUnknownError + #32 + CPassword;
        end;
      end;
    else
      Result := AResult + #32 + CUnknownError;
    end;
  end
  else
    Result := AResult + #32 + CUnknownError;
end;

function TMainWebModule.GetWindowsPath: String;
var
  LSize : Integer;
begin
  Result := '';

  LSize := GetWindowsDirectory(nil, 0);
  if (LSize > 0) then
  begin
    SetLength(Result, Succ(LSize));
    GetWindowsDirectory(@Result[1], Length(Result));

    Result := Trim(Result);
    if (Length(Result) > 0) then
    begin
      if (Result[Length(Result)] <> CPathDivider) then
        Result := Result + CPathDivider;
    end;
  end;
end;

procedure TMainWebModule.MainWebModuledefaultAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  LCGIDirectory : String;
  LParameters   : TStringList;
  LTextResult   : String;
  LValueRecord  : TValueRecord;
begin
  LCGIDirectory := GetCGIPath(Request.PathTranslated, Request.PathInfo, Request.ScriptName);
  if DirectoryExists(LCGIDirectory) then
  begin
    LValueRecord := ParseRequest(Request);

    case LValueRecord.Action of
      vaForward :
      begin
        if FileExists(LCGIDirectory + CForwardVBS) then
        begin
          LParameters := TStringList.Create;
          try
            LParameters.Add(CNoLogoParam);
            LParameters.Add(LCGIDirectory + CForwardVBS);
            if (Length(Trim(LValueRecord.Domain)) > 0) then
              LParameters.Add(LValueRecord.Domain);
            if (Length(Trim(LValueRecord.Username)) > 0) then
              LParameters.Add(LValueRecord.Username);
            if (Length(Trim(LValueRecord.Password)) > 0) then
              LParameters.Add(LValueRecord.Password);
            if (Length(Trim(LValueRecord.ForwardAddress)) > 0) then
              LParameters.Add(LValueRecord.ForwardAddress);

            LTextResult := Trim(GetApplicationOutput(GetWindowsPath + CCscriptExe, LParameters));
            Response.Content := GetResultString(LValueRecord.Action, LTextResult);
          finally
            LParameters.Free;
          end;
        end;
      end;

      vaPassword :
      begin
        if FileExists(LCGIDirectory + CPasswordVBS) then
        begin
          LParameters := TStringList.Create;
          try
            LParameters.Add(CNoLogoParam);
            LParameters.Add(LCGIDirectory + CPasswordVBS);
            if (Length(Trim(LValueRecord.Domain)) > 0) then
              LParameters.Add(LValueRecord.Domain);
            if (Length(Trim(LValueRecord.Username)) > 0) then
              LParameters.Add(LValueRecord.Username);
            if (Length(Trim(LValueRecord.Password)) > 0) then
              LParameters.Add(LValueRecord.Password);
            if (Length(Trim(LValueRecord.NewPassword)) > 0) then
              LParameters.Add(LValueRecord.NewPassword);

            LTextResult := Trim(GetApplicationOutput(GetWindowsPath + CCscriptExe, LParameters));
            Response.Content := GetResultString(LValueRecord.Action, LTextResult);
          finally
            LParameters.Free;
          end;
        end;
      end;
    else
      Response.Content := '';
    end;
  end;

  Handled := true;
end;

function TMainWebModule.ParseRequest(ARequest: TWebRequest) : TValueRecord;
var
  LAction     : String;
  LIndex      : Integer;
  LScriptName : String;
  LUsername   : String;
begin
  Result.Action         := vaUnknown;
  Result.Domain         := '';
  Result.Username       := '';
  Result.Password       := '';
  Result.ForwardAddress := '';
  Result.NewPassword    := '';

  if (ARequest <> nil) then
  begin
    LScriptName := AnsiLowerCase(Trim(ARequest.ScriptName));
    if (Length(LScriptName) > 0) then
    begin
      // kill trailing slash
      if (LScriptName[Length(LScriptName)] = CURLDivider) then
        Delete(LScriptName, Length(LScriptName), 1);

      // read trailing value - is username
      // kill trailing value
      for LIndex := Length(LScriptName) downto 1 do
      begin
        if (LScriptName[LIndex] = CURLDivider) then
        begin
          LUserName := Copy(LScriptName, Succ(LIndex), Length(LScriptName) - LIndex);
          Delete(LScriptName, LIndex, Length(LScriptName) - Pred(LIndex));

          Break;
        end;
      end;

      // read trailing value - is action
      // kill trailing value
      for LIndex := Length(LScriptName) downto 1 do
      begin
        if (LScriptName[LIndex] = CURLDivider) then
        begin
          LAction := Copy(LScriptName, Succ(LIndex), Length(LScriptName) - LIndex);
          Delete(LScriptName, LIndex, Length(LScriptName) - Pred(LIndex));

          Break;
        end;
      end;

      // check action string
      if AnsiSameText(LAction, CForwardAction) then
        Result.Action := vaForward;
      if AnsiSameText(LAction, CPasswordAction) then
        Result.Action := vaPassword;

      case Result.Action of
        vaForward :
        begin
          // read "forward" parameter
          LIndex := Request.QueryFields.IndexOfName(CForwardParam);
          if (LIndex >= 0) then
            Result.ForwardAddress := Request.QueryFields.ValueFromIndex[LIndex];

          // read "password" parameter
          LIndex := Request.QueryFields.IndexOfName(CPasswordParam);
          if (LIndex >= 0) then
            Result.Password := Request.QueryFields.ValueFromIndex[LIndex];

          Result.Domain   := Request.Host;
          Result.Username := LUserName;
        end;

        vaPassword :
        begin
          // read "new" parameter
          LIndex := Request.QueryFields.IndexOfName(CNewParam);
          if (LIndex >= 0) then
            Result.NewPassword := Request.QueryFields.ValueFromIndex[LIndex];

          // read "password" parameter
          LIndex := Request.QueryFields.IndexOfName(CPasswordParam);
          if (LIndex >= 0) then
            Result.Password := Request.QueryFields.ValueFromIndex[LIndex];

          Result.Domain   := Request.Host;
          Result.Username := LUserName;
        end;
      end;
    end;
  end;
end;

end.

In dem Programm selber gehen wir folgendermaßen vor:

  1. Wir parsen den URL-String.
  2. Wir führen das entsprechende VBScript aus.
  3. Wir lesen den Antwortwert aus stdout.
  4. Wir geben den erhaltenen Ergebniscode zurück.

Für den Zugriff habe ich mir ein tolles URL-Schema überlegt, das eingehalten werden muss, damit das Programm die richtigen Daten auslesen kann. Folgende Befehle gelten für das Setzen einer Mailumleitung:

1
2
https://[domain]/cgi-bin/[exedatei]/forward/[username]?password=[password]
https://[domain]/cgi-bin/[exedatei]/forward/[username]?password=[password]&forward=[email]

Durch das Setzen des forward-Parameters wird die Umleitung aktiviert. Durch Weglassen des Parameters wird die Umleitung deaktiviert. 🙂

Für das Ändern des Passworts wird folgendes URL-Schema benutzt. Wenn man ein Mail-Forwarding einrichten kann, dann kann man auch sein Passwort ändern - die Befehle unterscheiden sich nur geringfügig:

1
https://[domain]/cgi-bin/[exedatei]/password/[username]?password=[password]&new=[newpassword]

Was haltet ihr von dieser Form der Implementierung? Denkt ihr, ein Benutzer kann sich zwei URLs merke? Wie findet ihr den Lösungsansatz generell?
Update:
Der vorhandene Exploit wurde nun behoben. Das Problem war, dass die übergebenen Parameter nicht überprüft wurden, bevor sie in den auszuführenden Befehl eingebaut wurden. Nun werden Anführungszeichen escaped, um das Hinzufügen von zusätzlichen Parametern und andere Modifikationen des Befehls zu unterbinden (Stichwort Pipes).
Konfigurierende Grüße, Kenny

Schreibe einen Kommentar

Um Ihnen beim weiteren Kommentieren auf dieser Webseite die erneute Eingabe Ihrer Daten zu ersparen, wird beim Absenden Ihres Kommentars ein Cookie an Ihren Browser gesendet und von diesem gespeichert. Mit dem Absenden eines Kommentars auf dieser Webseite stimmen Sie der Speicherung und Übertragung dieses Cookies explizit zu.

Pflichtfelder sind mit * markiert.