ADDED MVCDocAttributes

ADDED Alias MVCHTTPMethodsAttribute to MVCHTTPMethodAttribute

sources/MVCFramework.SysControllers.pas

@@ -8,6 +8,7 @@ uses
 type
 
   [MVCPath('/system')]
+  [MVCDoc('Built-in DelphiMVCFramework System controller')]
   TMVCSystemController = class(TMVCController)
   protected
     procedure OnBeforeAction(Context: TWebContext; const AActionNAme: string;
@@ -15,12 +16,17 @@ type
     function GetUpTime: string;
   public
     [MVCPath('/describeserver.info')]
+    [MVCHTTPMethods([httpGET, httpPOST])]
+    [MVCDoc('Describe controllers and actions published by the RESTful server per resources')
+      ]
     procedure DescribeServer(Context: TWebContext);
 
     [MVCPath('/describeplatform.info')]
+    [MVCDoc('Describe the system where server is running')]
     procedure DescribePlatform(Context: TWebContext);
 
     [MVCPath('/serverconfig.info')]
+    [MVCDoc('Server configuration')]
     procedure ServerConfig(Context: TWebContext);
   end;
 
@@ -69,7 +75,8 @@ begin
   try
     LJRes.AddPair('OS', TOSVersion.ToString);
     LJRes.AddPair('CPU_count', TJSONNumber.Create(TThread.ProcessorCount));
-    LJRes.AddPair('CPU_architecture', GetEnumName(TypeInfo(TOSVersion.TArchitecture),
+    LJRes.AddPair('CPU_architecture',
+      GetEnumName(TypeInfo(TOSVersion.TArchitecture),
       Ord(TOSVersion.Architecture)));
     LJRes.AddPair('system_uptime', GetUpTime);
     ContentType := TMVCMimeType.APPLICATION_JSON;
@@ -93,6 +100,7 @@ var
   LFoundAttrib: Boolean;
   LStrRelativePath: string;
   LStrHTTPMethods: string;
+  LStrDoc: string;
   LStrConsumes: string;
   LStrProduces: string;
   LJMethod: TJSONObject;
@@ -108,7 +116,11 @@ begin
       for LAttribute in LRTTIType.GetAttributes do
       begin
         if LAttribute is MVCPathAttribute then
-          ControllerInfo.AddPair('resource_path', MVCPathAttribute(LAttribute).Path)
+          ControllerInfo.AddPair('resource_path',
+            MVCPathAttribute(LAttribute).Path);
+        if LAttribute is MVCDocAttribute then
+          ControllerInfo.AddPair('description',
+            MVCDocAttribute(LAttribute).Value);
       end;
 
       LJMethods := TJSONArray.Create;
@@ -121,8 +133,15 @@ begin
         LStrHTTPMethods := '';
         LStrConsumes := '';
         LStrProduces := '';
+        LStrHTTPMethods :=
+          'httpGET,httpPOST,httpPUT,httpDELETE,httpHEAD,httpOPTIONS,httpPATCH,httpTRACE';
         for LAttribute in LMethod.GetAttributes do
         begin
+          if LAttribute is MVCDocAttribute then
+          begin
+            LStrDoc := MVCDocAttribute(LAttribute).Value;
+            LFoundAttrib := true;
+          end;
           if LAttribute is MVCPathAttribute then
           begin
             LStrRelativePath := MVCPathAttribute(LAttribute).Path;
@@ -130,7 +149,8 @@ begin
           end;
           if LAttribute is MVCHTTPMethodAttribute then
           begin
-            LStrHTTPMethods := MVCHTTPMethodAttribute(LAttribute).MVCHTTPMethodsAsString;
+            LStrHTTPMethods := MVCHTTPMethodAttribute(LAttribute)
+              .MVCHTTPMethodsAsString;
             LFoundAttrib := true;
           end;
           if LAttribute is MVCConsumesAttribute then
@@ -153,6 +173,7 @@ begin
           LJMethod.AddPair('consumes', LStrConsumes);
           LJMethod.AddPair('produces', LStrProduces);
           LJMethod.AddPair('http_methods', LStrHTTPMethods);
+          LJMethod.AddPair('description', LStrDoc);
           LJMethods.AddElement(LJMethod);
         end;
       end;
@@ -169,15 +190,15 @@ begin
   Result := MSecToTime(GetTickCount);
 end;
 
-procedure TMVCSystemController.OnBeforeAction(Context: TWebContext; const AActionNAme: string;
+procedure TMVCSystemController.OnBeforeAction(Context: TWebContext;
-  var Handled: Boolean);
+  const AActionNAme: string; var Handled: Boolean);
 var
   LClientIP: string;
 begin
   inherited;
   LClientIP := Context.Request.ClientIP;
-  Handled := not((LClientIP = '127.0.0.1') or (LClientIP = '0:0:0:0:0:0:0:1') or
+  Handled := not((LClientIP = '::1') or (LClientIP = '127.0.0.1') or
-    (LClientIP.ToLower = 'localhost'));
+    (LClientIP = '0:0:0:0:0:0:0:1') or (LClientIP.ToLower = 'localhost'));
 end;
 
 procedure TMVCSystemController.ServerConfig(Context: TWebContext);

sources/MVCFramework.pas

@@ -51,6 +51,8 @@ type
 
   end;
 
+  MVCHTTPMethodsAttribute = MVCHTTPMethodAttribute; //just an alias
+
   MVCBaseAttribute = class(TCustomAttribute)
 
   end;
@@ -68,6 +70,10 @@ type
 
   end;
 
+  MVCDocAttribute = class(MVCStringAttribute)
+
+  end;
+
   MVCProducesAttribute = class(MVCStringAttribute)
   private
     FProduceEncoding: string;
@@ -117,7 +123,7 @@ type
     destructor Destroy; override;
     procedure SetParamsTable(AParamsTable: TMVCRequestParamsTable);
     function GetParamNames: TArray<string>;
-    function ClientIP: string; virtual; abstract;
+    function ClientIP: string; virtual;
     function ClientPrefer(MimeType: string): boolean;
     function ThereIsRequestBody: boolean;
     function Accept: string;
@@ -152,21 +158,17 @@ type
   TMVCApacheWebRequest = class(TMVCWebRequest)
   public
     constructor Create(AWebRequest: TWebRequest); override;
-    function ClientIP: string; override;
   end;
 {$ENDIF}
 
   TMVCISAPIWebRequest = class(TMVCWebRequest)
   public
     constructor Create(AWebRequest: TWebRequest); override;
-    function ClientIP: string; override;
   end;
 
   TMVCINDYWebRequest = class(TMVCWebRequest)
   public
     constructor Create(AWebRequest: TWebRequest); override;
-    function ClientIP: string; override;
-
   end;
 
 {$IFDEF IOCP}
@@ -1335,6 +1337,60 @@ begin
       [ContentType]);
 end;
 
+function TMVCWebRequest.ClientIP: string;
+{
+  This code has been converted to Delphi from a PHP code
+  http://www.grantburton.com/2008/11/30/fix-for-incorrect-ip-addresses-in-wordpress-comments/
+}
+var
+  S: string;
+begin
+  if FWebRequest.GetFieldByName('HTTP_CLIENT_IP') <> '' then
+    Exit(FWebRequest.GetFieldByName('HTTP_CLIENT_IP'));
+
+  for S in String(FWebRequest.GetFieldByName('HTTP_X_FORWARDED_FOR'))
+    .Split([',']) do
+  begin
+    if not S.trim.IsEmpty then
+      Exit(S.trim);
+  end;
+
+  if FWebRequest.GetFieldByName('HTTP_X_FORWARDED') <> '' then
+    Exit(FWebRequest.GetFieldByName('HTTP_X_FORWARDED'));
+
+  if FWebRequest.GetFieldByName('HTTP_X_CLUSTER_CLIENT_IP') <> '' then
+    Exit(FWebRequest.GetFieldByName('HTTP_X_CLUSTER_CLIENT_IP'));
+
+  if FWebRequest.GetFieldByName('HTTP_FORWARDED_FOR') <> '' then
+    Exit(FWebRequest.GetFieldByName('HTTP_FORWARDED_FOR'));
+
+  if FWebRequest.GetFieldByName('HTTP_FORWARDED') <> '' then
+    Exit(FWebRequest.GetFieldByName('HTTP_FORWARDED'));
+
+  if FWebRequest.GetFieldByName('REMOTE_ADDR') <> '' then
+    Exit(FWebRequest.GetFieldByName('REMOTE_ADDR'));
+
+  if FWebRequest.RemoteIP <> '' then
+    Exit(FWebRequest.RemoteIP);
+
+  if FWebRequest.RemoteAddr <> '' then
+    Exit(FWebRequest.RemoteAddr);
+
+  if FWebRequest.RemoteHost <> '' then
+    Exit(FWebRequest.RemoteHost);
+
+  if FWebRequest.RemoteAddr <> '' then
+    Exit(FWebRequest.RemoteAddr);
+
+  if FWebRequest.RemoteIP <> '' then
+    Exit(FWebRequest.RemoteIP);
+
+  if FWebRequest.RemoteHost <> '' then
+    Exit(FWebRequest.RemoteHost);
+
+  Result := '';
+end;
+
 function TMVCWebRequest.ClientPrefer(MimeType: string): boolean;
 begin
   Result := AnsiPos(MimeType, LowerCase(RawWebRequest.Accept)) = 1;
@@ -1416,8 +1472,6 @@ begin
   inherited;
 end;
 
-
-
 procedure TMVCController.EnqueueMessageOnTopicOrQueue(const IsQueue: boolean;
   const ATopic: string; AJSONObject: TJSONObject; AOwnsInstance: boolean);
 var
@@ -2066,11 +2120,6 @@ end;
 
 { TMVCISAPIWebRequest }
 
-function TMVCISAPIWebRequest.ClientIP: string;
-begin
-  raise EMVCException.Create('<TMVCISAPIWebRequest.ClientIP> Not implemented');
-end;
-
 constructor TMVCISAPIWebRequest.Create(AWebRequest: TWebRequest);
 begin
   inherited;
@@ -2080,11 +2129,6 @@ end;
 { TMVCApacheWebRequest }
 {$IF CompilerVersion >= 27}
 
-function TMVCApacheWebRequest.ClientIP: string;
-begin
-  raise EMVCException.Create('<TMVCApacheWebRequest.ClientIP> Not implemented');
-end;
-
 constructor TMVCApacheWebRequest.Create(AWebRequest: TWebRequest);
 begin
   inherited;
@@ -2093,91 +2137,6 @@ end;
 {$ENDIF}
 { TMVCINDYWebRequest }
 
-function TMVCINDYWebRequest.ClientIP: string;
-{
-  This code has been converted to Delphi from a PHP code
-  http://www.grantburton.com/2008/11/30/fix-for-incorrect-ip-addresses-in-wordpress-comments/
-}
-  function CheckIP(IP: string): boolean;
-  // var
-  // IPv6Address: TIdIPv6Address;
-  // LErr: boolean;
-  begin
-    // this is not a real check, it checks only if the IP is not empty
-    Result := not IP.IsEmpty;
-
-    //
-    // idglobal.IPv6ToIdIPv6Address(IP, IPv6Address, LErr);
-    // Result := LErr and (not IP.IsEmpty) and { (IP2Long(IP) <> -1) and }
-    // (IP2Long(IP) > 0);
-  end;
-
-var
-  S: string;
-  req: TIdHTTPAppRequestHack;
-
-{$IFDEF IOCP}
-  Headers: TStringList;
-
-{$ELSE}
-  Headers: TIdHeaderList;
-
-{$ENDIF}
-begin
-  req := TIdHTTPAppRequestHack(FWebRequest);
-
-{$IFDEF IOCP}
-  Headers := req.FHttpConnection.RequestHeader;
-
-{$ELSE}
-  Headers := req.FRequestInfo.RawHeaders;
-
-{$ENDIF}
-  if CheckIP(Headers.Values['HTTP_CLIENT_IP']) then
-    Exit(Headers.Values['HTTP_CLIENT_IP']);
-
-  for S in Headers.Values['HTTP_X_FORWARDED_FOR'].Split([',']) do
-  begin
-    if CheckIP(S.trim) then
-      Exit(S.trim);
-  end;
-
-  if CheckIP(Headers.Values['HTTP_X_FORWARDED']) then
-    Exit(Headers.Values['HTTP_X_FORWARDED']);
-
-  if CheckIP(Headers.Values['HTTP_X_CLUSTER_CLIENT_IP']) then
-    Exit(Headers.Values['HTTP_X_CLUSTER_CLIENT_IP']);
-
-  if CheckIP(Headers.Values['HTTP_FORWARDED_FOR']) then
-    Exit(Headers.Values['HTTP_FORWARDED_FOR']);
-
-  if CheckIP(Headers.Values['HTTP_FORWARDED']) then
-    Exit(Headers.Values['HTTP_FORWARDED']);
-
-  if CheckIP(Headers.Values['REMOTE_ADDR']) then
-    Exit(Headers.Values['REMOTE_ADDR']);
-
-  if CheckIP(FWebRequest.RemoteIP) then
-    Exit(FWebRequest.RemoteIP);
-
-  if CheckIP(FWebRequest.RemoteAddr) then
-    Exit(FWebRequest.RemoteAddr);
-
-  if CheckIP(FWebRequest.RemoteHost) then
-    Exit(FWebRequest.RemoteHost);
-
-  if CheckIP(req.RemoteAddr) then
-    Exit(req.RemoteAddr);
-
-  if CheckIP(req.RemoteIP) then
-    Exit(req.RemoteIP);
-
-  if CheckIP(req.RemoteHost) then
-    Exit(req.RemoteHost);
-
-  Result := '';
-end;
-
 constructor TMVCINDYWebRequest.Create(AWebRequest: TWebRequest);
 begin
   inherited;