├── COPYING.lesser ├── README.md ├── changelog ├── doc └── User Guide.pdf ├── examples ├── gui │ ├── MainFrame.lfm │ ├── MainFrame.pas │ ├── oauth2test.lpi │ └── oauth2test.lpr ├── nongui │ ├── oauth2test.lpi │ └── oauth2test.lpr └── server │ ├── endpoints │ ├── authorise.php │ ├── resource.php │ └── token.php │ ├── schema.sql │ ├── server.php │ ├── setup.sh │ └── testserver.sh ├── images └── oauth2client.png ├── languages ├── oauth2Client.pot └── oauth2errors.pot ├── oauth2_laz.lpk ├── oauth2_laz.pas └── src ├── oauth2Client.pas ├── oauth2client.lrs ├── oauth2errors.pas └── oauth2tokens.pas /COPYING.lesser: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # oauth2client 2 | 3 | An RFC 6749 OAuth2 Client implemented as a Lazarus Package. 4 | 5 | The client is intended to be fully featured and supports the following grant types: 6 | 7 | * Authorization Code Grant 8 | * Implicit Grant 9 | * Resource Owner Password Credentials Grant 10 | * Client Credentials Grant. 11 | 12 | Attention has also been paid to extensibility. The client also provides: 13 | 14 | * A means of implementing an Extension Grant, including new grant types. 15 | * Support for new token types 16 | * Support for New Endpoint Parameters, and 17 | * Support for additional error codes. 18 | 19 | This OAuth2 Client uses an external User Agent - the System Web Browser - and incorporates in internal http server for handling redirect responses from an Authorization Server. 20 | 21 | The package uses the Indy Component library for both an http/https client and an http server. When the https protocol is used the OpenSSL library must also be installed and available for use. 22 | 23 | Multithreading support is required for Authorization Code and Implicit Grants. 24 | 25 | The package is written in Object Pascal and is made available under the Lesser GPL. 26 | 27 | The package requires the Indy package for http/https protocol support. It has been configured for 28 | use with the MWA Software Indy.ProposedUpdate fork of IndySockets. 29 | 30 | The package can still be used with the 10.6 version of Indy. However, you will be limited to using the unsupported OpenSSL 1.0.2 library (current is OpenSSL 3.x) and TLS 1.2. 31 | 32 | In order to use the package with Indy 10.6, you must compile with the "USING_INDY10_6" defined symbol and change the oauth2_laz package dependency from indyopenssl to indylaz. 33 | -------------------------------------------------------------------------------- /changelog: -------------------------------------------------------------------------------- 1 | OAUTH2 Change Log version (1.1-0 ) Tue, 31 Dec 2024 14:50 +0000 2 | 3 | 1. Update to use MWA Software's Indy.ProprosedUpdate package 4 | 5 | OAUTH2 Change Log version (1.0-0 ) Mon, 23 Aug 2021 11:43:33 +0100 6 | 7 | 1. Initial Release 8 | 9 | -------------------------------------------------------------------------------- /doc/User Guide.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MWASoftware/oauth2client/3c30d2e09d17452d8fbfe4a7cf7240bb3f68c952/doc/User Guide.pdf -------------------------------------------------------------------------------- /examples/gui/MainFrame.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 676 3 | Height = 425 4 | Top = 182 5 | Width = 856 6 | Caption = 'Oauth 2 Test' 7 | ClientHeight = 425 8 | ClientWidth = 856 9 | DefaultMonitor = dmPrimary 10 | OnShow = FormShow 11 | Position = poScreenCenter 12 | LCLVersion = '2.2.0.2' 13 | object Memo1: TMemo 14 | Left = 16 15 | Height = 338 16 | Top = 8 17 | Width = 671 18 | Anchors = [akTop, akLeft, akRight, akBottom] 19 | Lines.Strings = ( 20 | 'Memo1' 21 | ) 22 | ScrollBars = ssAutoVertical 23 | TabOrder = 0 24 | end 25 | object Button1: TButton 26 | Left = 16 27 | Height = 25 28 | Top = 352 29 | Width = 160 30 | Caption = 'Get Client Credentials' 31 | OnClick = Button1Click 32 | TabOrder = 1 33 | end 34 | object Button2: TButton 35 | Left = 184 36 | Height = 25 37 | Top = 352 38 | Width = 168 39 | Caption = 'Get Authorization' 40 | OnClick = Button2Click 41 | TabOrder = 2 42 | end 43 | object RefreshBtn: TButton 44 | Left = 368 45 | Height = 25 46 | Top = 352 47 | Width = 144 48 | Caption = 'Refresh Access Token' 49 | Enabled = False 50 | OnClick = RefreshBtnClick 51 | TabOrder = 3 52 | end 53 | object RadioGroup1: TRadioGroup 54 | Left = 696 55 | Height = 50 56 | Top = 200 57 | Width = 141 58 | AutoFill = True 59 | Caption = 'Client Authentication' 60 | ChildSizing.LeftRightSpacing = 6 61 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 62 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 63 | ChildSizing.ShrinkHorizontal = crsScaleChilds 64 | ChildSizing.ShrinkVertical = crsScaleChilds 65 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 66 | ChildSizing.ControlsPerLine = 1 67 | ClientHeight = 34 68 | ClientWidth = 139 69 | ItemIndex = 1 70 | Items.Strings = ( 71 | 'Basic' 72 | 'Inline' 73 | ) 74 | OnClick = RadioGroup1Click 75 | TabOrder = 4 76 | end 77 | object Button3: TButton 78 | Left = 520 79 | Height = 25 80 | Top = 352 81 | Width = 168 82 | Caption = 'User Password Grant' 83 | OnClick = Button3Click 84 | TabOrder = 5 85 | end 86 | object ScopeSelection: TRadioGroup 87 | Left = 699 88 | Height = 61 89 | Top = 283 90 | Width = 141 91 | AutoFill = True 92 | Caption = 'Scope' 93 | ChildSizing.LeftRightSpacing = 6 94 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 95 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 96 | ChildSizing.ShrinkHorizontal = crsScaleChilds 97 | ChildSizing.ShrinkVertical = crsScaleChilds 98 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 99 | ChildSizing.ControlsPerLine = 1 100 | ClientHeight = 45 101 | ClientWidth = 139 102 | ItemIndex = 0 103 | Items.Strings = ( 104 | 'testing' 105 | 'bad' 106 | ) 107 | TabOrder = 6 108 | end 109 | object Button4: TButton 110 | Left = 699 111 | Height = 25 112 | Top = 352 113 | Width = 125 114 | Caption = 'Implicit Grant' 115 | OnClick = Button4Click 116 | TabOrder = 7 117 | end 118 | object CancelBtn: TButton 119 | Left = 320 120 | Height = 25 121 | Top = 384 122 | Width = 75 123 | Caption = 'Cancel' 124 | Enabled = False 125 | OnClick = CancelBtnClick 126 | TabOrder = 8 127 | end 128 | object ResourceBtn: TButton 129 | Left = 699 130 | Height = 25 131 | Top = 384 132 | Width = 123 133 | Caption = 'Access Resource' 134 | OnClick = ResourceBtnClick 135 | TabOrder = 9 136 | end 137 | object OAuth2Client: TOAuth2Client 138 | ClientID = 'OAuth2Tester' 139 | ClientSecret = 'masterkey' 140 | AuthEndPoint = 'http://localhost/oauth2/authorise.php' 141 | TokenEndPoint = 'http://localhost/oauth2/token.php' 142 | ClientAuthType = caInline 143 | RedirectURI = 'http://localhost:8080' 144 | PortNo = 8080 145 | OnAccessToken = OAuth2ClientAccessToken 146 | OnErrorResponse = OAuth2ClientErrorResponse 147 | Left = 80 148 | Top = 272 149 | end 150 | object httpClient: TIdHTTP 151 | ProxyParams.BasicAuthentication = False 152 | ProxyParams.ProxyPort = 0 153 | Request.ContentLength = -1 154 | Request.ContentRangeEnd = -1 155 | Request.ContentRangeStart = -1 156 | Request.ContentRangeInstanceLength = -1 157 | Request.ContentType = 'application/x-www-form-urlencoded' 158 | Request.Accept = 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' 159 | Request.BasicAuthentication = False 160 | Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)' 161 | Request.Ranges.Units = 'bytes' 162 | Request.Ranges = <> 163 | HTTPOptions = [hoForceEncodeParams, hoNoProtocolErrorException, hoWantProtocolErrorContent] 164 | Left = 192 165 | Top = 272 166 | end 167 | object SSLHandler: TIdSSLIOHandlerSocketOpenSSL 168 | MaxLineAction = maException 169 | Port = 0 170 | DefaultPort = 0 171 | SSLOptions.Method = sslvTLSv1_2 172 | SSLOptions.SSLVersions = [sslvTLSv1_2] 173 | SSLOptions.Mode = sslmClient 174 | SSLOptions.VerifyMode = [] 175 | SSLOptions.VerifyDepth = 0 176 | Left = 288 177 | Top = 272 178 | end 179 | end 180 | -------------------------------------------------------------------------------- /examples/gui/MainFrame.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the MWA Software OAuth2 Client. 3 | 4 | The MWA Software OAuth2 Client is free software: you can redistribute it 5 | and/or modify it under the terms of the GNU Lesser General Public License as 6 | published by the Free Software Foundation, either version 3 of the License, or 7 | (at your option) any later version. 8 | 9 | The MWA Software OAuth2 Client is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU Lesser General Public License for more details. 13 | 14 | You should have received a copy of the GNU Lesser General Public License 15 | along with the MWA Software OAuth2 Client. If not, see . 16 | } 17 | unit MainFrame; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, 25 | Interfaces, oauth2Client, IdHTTP, IdSSLOpenSSL; 26 | 27 | const 28 | {User for Resource Owner Password Grant} 29 | UserName = 'atester'; 30 | Password = 'test2021'; 31 | 32 | type 33 | 34 | { TForm1 } 35 | 36 | TForm1 = class(TForm) 37 | Button1: TButton; 38 | Button2: TButton; 39 | Button3: TButton; 40 | Button4: TButton; 41 | httpClient: TIdHTTP; 42 | SSLHandler: TIdSSLIOHandlerSocketOpenSSL; 43 | ResourceBtn: TButton; 44 | CancelBtn: TButton; 45 | OAuth2Client: TOAuth2Client; 46 | RadioGroup1: TRadioGroup; 47 | ScopeSelection: TRadioGroup; 48 | RefreshBtn: TButton; 49 | Memo1: TMemo; 50 | procedure Button1Click(Sender: TObject); 51 | procedure Button2Click(Sender: TObject); 52 | procedure Button3Click(Sender: TObject); 53 | procedure Button4Click(Sender: TObject); 54 | procedure CancelBtnClick(Sender: TObject); 55 | procedure FormShow(Sender: TObject); 56 | procedure OAuth2ClientAccessToken(Sender: TObject; AccessToken, 57 | RefreshToken, TokenScope: string; expires_in: integer); 58 | procedure OAuth2ClientErrorResponse(Sender: TObject; E: Exception); 59 | procedure RadioGroup1Click(Sender: TObject); 60 | procedure RefreshBtnClick(Sender: TObject); 61 | procedure ResourceBtnClick(Sender: TObject); 62 | private 63 | FRefreshToken: string; 64 | FAccessToken: string; 65 | end; 66 | 67 | var 68 | Form1: TForm1; 69 | 70 | implementation 71 | 72 | uses URIParser, oauth2tokens; 73 | 74 | const ResourceURL: string = 'http://localhost/oauth2/resource.php'; 75 | 76 | {$R *.lfm} 77 | 78 | type 79 | 80 | { TResouceResponse } 81 | 82 | TResouceResponse = class(TOAuth2Response) 83 | private 84 | FMessage: string; 85 | FSuccess: string; 86 | protected 87 | procedure ValidateResponse; override; 88 | public 89 | constructor Create(responseStr: string); 90 | published 91 | property success: string read FSuccess write FSuccess; 92 | property message: string read FMessage write FMessage; 93 | end; 94 | 95 | { TResouceResponse } 96 | 97 | procedure TResouceResponse.ValidateResponse; 98 | begin 99 | //nothing to validate 100 | end; 101 | 102 | constructor TResouceResponse.Create(responseStr: string); 103 | begin 104 | inherited Create; 105 | ParseJsonResponse(responseStr); 106 | end; 107 | 108 | { TForm1 } 109 | 110 | procedure TForm1.Button1Click(Sender: TObject); 111 | var AccessToken: string; 112 | expires_in: integer; 113 | TokenScope: string; 114 | begin 115 | try 116 | OAuth2Client.GrantClientCredentials(ScopeSelection.Items[ScopeSelection.ItemIndex],AccessToken,TokenScope,expires_in); 117 | Memo1.Lines.Add('Get Client Credentials: Access Token = "' + AccessToken + '"'); 118 | Memo1.Lines.Add('Expires In = ' + IntToStr(expires_in) + ' seconds, Scope = ' + TokenScope); 119 | except on E: Exception do 120 | Memo1.Lines.Add('Error: ' + E.message); 121 | end; 122 | FAccessToken := AccessToken; 123 | end; 124 | 125 | procedure TForm1.Button2Click(Sender: TObject); 126 | begin 127 | try 128 | OAuth2Client.GrantAuthorizationCodeAsync(ScopeSelection.Items[ScopeSelection.ItemIndex]); 129 | Memo1.Lines.Add('Enter credentials in web browser'); 130 | except on E: Exception do 131 | begin 132 | Memo1.Lines.Add('Error: ' + E.message); 133 | end; 134 | end; 135 | CancelBtn.Enabled := true; 136 | end; 137 | 138 | procedure TForm1.Button3Click(Sender: TObject); 139 | var AccessToken: string; 140 | RefreshToken: string; 141 | TokenScope: string; 142 | expires_in: integer; 143 | begin 144 | try 145 | OAuth2Client.GrantUserPasswordCredentials(ScopeSelection.Items[ScopeSelection.ItemIndex],UserName,Password, 146 | AccessToken,RefreshToken,TokenScope,expires_in); 147 | Memo1.Lines.Add('Get User Password Credentials: Access Token = "' + AccessToken + '"'); 148 | Memo1.Lines.Add('Refresh Token = "' + RefreshToken + '"'); 149 | Memo1.Lines.Add('Scope = "' + TokenScope + '"'); 150 | Memo1.Lines.Add('Expires In = ' + IntToStr(expires_in) + ' seconds'); 151 | if RefreshToken <> '' then 152 | FRefreshToken := RefreshToken; 153 | RefreshBtn.Enabled := RefreshToken <> ''; 154 | except on E: Exception do 155 | Memo1.Lines.Add('Error: ' + E.message); 156 | end; 157 | FAccessToken := AccessToken; 158 | end; 159 | 160 | procedure TForm1.Button4Click(Sender: TObject); 161 | begin 162 | try 163 | OAuth2Client.ImplicitGrantAsync(ScopeSelection.Items[ScopeSelection.ItemIndex]); 164 | Memo1.Lines.Add('Enter credentials in web browser'); 165 | except on E: Exception do 166 | begin 167 | Memo1.Lines.Add('Error: ' + E.message); 168 | end; 169 | end; 170 | CancelBtn.Enabled := true; 171 | end; 172 | 173 | procedure TForm1.CancelBtnClick(Sender: TObject); 174 | begin 175 | OAuth2Client.CancelGrantRequest; 176 | CancelBtn.Enabled := false; 177 | end; 178 | 179 | procedure TForm1.FormShow(Sender: TObject); 180 | var ENVURI,EndpointURI: TURI; 181 | AuthServer: string; 182 | begin 183 | Memo1.Clear; 184 | AuthServer := GetEnvironmentVariable('AUTHSERVER'); 185 | if AuthServer <> '' then 186 | begin 187 | ENVURI := ParseURI(AuthServer); 188 | EndpointURI := ParseURI(OAuth2Client.AuthEndPoint); 189 | EndpointURI.Protocol := ENVURI.Protocol; 190 | EndpointURI.Host := ENVURI.Host; 191 | OAuth2Client.AuthEndPoint := EncodeURI(EndpointURI); 192 | EndpointURI := ParseURI(OAuth2Client.TokenEndPoint); 193 | EndpointURI.Protocol := ENVURI.Protocol; 194 | EndpointURI.Host := ENVURI.Host; 195 | OAuth2Client.TokenEndPoint := EncodeURI(EndpointURI); 196 | 197 | EndpointURI := ParseURI(ResourceURL); 198 | EndpointURI.Protocol := ENVURI.Protocol; 199 | EndpointURI.Host := ENVURI.Host; 200 | ResourceURL := EncodeURI(EndpointURI); 201 | end; 202 | Memo1.Lines.Add('Auth End Point = ' + OAuth2Client.AuthEndPoint); 203 | Memo1.Lines.Add('Token End Point = ' + OAuth2Client.TokenEndPoint); 204 | Memo1.Lines.Add('Resource URL = ' + ResourceURL); 205 | end; 206 | 207 | procedure TForm1.OAuth2ClientAccessToken(Sender: TObject; AccessToken, 208 | RefreshToken, TokenScope: string; expires_in: integer); 209 | begin 210 | Memo1.Lines.Add('Get Authorization Code: Access Token = "' + AccessToken+ '"'); 211 | Memo1.Lines.Add('Refresh Token = "' + RefreshToken + '"'); 212 | if RefreshToken <> '' then 213 | FRefreshToken := RefreshToken; 214 | if TokenScope <> '' then 215 | Memo1.Lines.Add('Scope Returned = ' + TokenScope); 216 | Memo1.Lines.Add('Expires In = ' + IntToStr(expires_in) + ' seconds'); 217 | RefreshBtn.Enabled := true; 218 | CancelBtn.Enabled := false; 219 | FAccessToken := AccessToken; 220 | end; 221 | 222 | procedure TForm1.OAuth2ClientErrorResponse(Sender: TObject; E: Exception); 223 | begin 224 | Memo1.Lines.Add('Error Response: ' + E.message); 225 | CancelBtn.Enabled := false; 226 | end; 227 | 228 | procedure TForm1.RadioGroup1Click(Sender: TObject); 229 | begin 230 | case RadioGroup1.ItemIndex of 231 | 0: 232 | OAuth2Client.ClientAuthType := caBasic; 233 | 1: 234 | OAuth2Client.ClientAuthType := caInline; 235 | end; 236 | end; 237 | 238 | procedure TForm1.RefreshBtnClick(Sender: TObject); 239 | var AccessToken: string; 240 | TokenScope: string; 241 | NewRefreshToken: string; 242 | expires_in: integer; 243 | begin 244 | try 245 | OAuth2Client.RefreshAccessToken('',FRefreshToken,AccessToken,TokenScope,NewRefreshToken,expires_in); 246 | Memo1.Lines.Add('Refresh Token: Access Token = "' + AccessToken + '" ' + 247 | 'Replacement Refresh Token = "' + NewRefreshToken + '" Expires In =' + 248 | IntToStr(expires_in) + ' seconds, Scope = ' + TokenScope); 249 | if NewRefreshToken <> '' then 250 | FRefreshToken := NewRefreshToken; 251 | except on E: Exception do 252 | Memo1.Lines.Add('Error: ' + E.message); 253 | end; 254 | FAccessToken := AccessToken; 255 | end; 256 | 257 | procedure TForm1.ResourceBtnClick(Sender: TObject); 258 | var Request: TOAuth2URLEncodedData; 259 | Response: TStringStream; 260 | ResouceResponse: TResouceResponse; 261 | begin 262 | if FAccessToken = '' then 263 | ShowMessage('You must get an Access Token First!') 264 | else 265 | begin 266 | if ParseURI(ResourceURL).Protocol = 'https' then 267 | httpClient.IOHandler := SSlHandler; 268 | httpClient.ConnectTimeout := 5000; 269 | httpClient.ReadTimeout := 5000; 270 | Request := TOAuth2URLEncodedData.Create; 271 | Response := TStringStream.Create(''); 272 | try 273 | Request.AddParam('access_token',FAccessToken); 274 | httpClient.Post(ResourceURL,Request,Response); 275 | Memo1.Lines.Add('Response = ' + IntToStr(httpClient.ResponseCode) + ' ' + httpClient.ResponseText); 276 | Memo1.Lines.Add('Response Body: ' + Response.DataString); 277 | ResouceResponse := TResouceResponse.Create(Response.DataString); 278 | try 279 | Memo1.Lines.Add('Parsed Response Body'); 280 | Memo1.Lines.Add('Success = ' + ResouceResponse.success); 281 | Memo1.Lines.Add('Message = ' + ResouceResponse.message); 282 | finally 283 | ResouceResponse.Free; 284 | end; 285 | finally 286 | Request.Free; 287 | Response.Free; 288 | end; 289 | end; 290 | end; 291 | 292 | 293 | end. 294 | 295 | -------------------------------------------------------------------------------- /examples/gui/oauth2test.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | <Scaled Value="True"/> 11 | <ResourceType Value="res"/> 12 | <UseXPManifest Value="True"/> 13 | <XPManifest> 14 | <DpiAware Value="True"/> 15 | </XPManifest> 16 | <Icon Value="0"/> 17 | </General> 18 | <BuildModes Count="1"> 19 | <Item1 Name="Default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | <Modes Count="0"/> 28 | </RunParams> 29 | <RequiredPackages Count="2"> 30 | <Item1> 31 | <PackageName Value="oauth2_laz"/> 32 | </Item1> 33 | <Item2> 34 | <PackageName Value="LCL"/> 35 | </Item2> 36 | </RequiredPackages> 37 | <Units Count="2"> 38 | <Unit0> 39 | <Filename Value="oauth2test.lpr"/> 40 | <IsPartOfProject Value="True"/> 41 | </Unit0> 42 | <Unit1> 43 | <Filename Value="MainFrame.pas"/> 44 | <IsPartOfProject Value="True"/> 45 | <ComponentName Value="Form1"/> 46 | <HasResources Value="True"/> 47 | <ResourceBaseClass Value="Form"/> 48 | </Unit1> 49 | </Units> 50 | </ProjectOptions> 51 | <CompilerOptions> 52 | <Version Value="11"/> 53 | <PathDelim Value="\"/> 54 | <Target> 55 | <Filename Value="oauth2test"/> 56 | </Target> 57 | <SearchPaths> 58 | <IncludeFiles Value="$(ProjOutDir)"/> 59 | <OtherUnitFiles Value="."/> 60 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 61 | </SearchPaths> 62 | <Linking> 63 | <Options> 64 | <Win32> 65 | <GraphicApplication Value="True"/> 66 | </Win32> 67 | </Options> 68 | </Linking> 69 | <Other> 70 | <CustomOptions Value="-dUseCThreads"/> 71 | </Other> 72 | </CompilerOptions> 73 | <Debugging> 74 | <Exceptions Count="3"> 75 | <Item1> 76 | <Name Value="EAbort"/> 77 | </Item1> 78 | <Item2> 79 | <Name Value="ECodetoolError"/> 80 | </Item2> 81 | <Item3> 82 | <Name Value="EFOpenError"/> 83 | </Item3> 84 | </Exceptions> 85 | </Debugging> 86 | </CONFIG> 87 | -------------------------------------------------------------------------------- /examples/gui/oauth2test.lpr: -------------------------------------------------------------------------------- 1 | program oauth2test; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, indylaz, MainFrame; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | RequireDerivedFormResource:=True; 16 | Application.Scaled := True; 17 | Application.Initialize; 18 | Application.CreateForm(TForm1, Form1); 19 | Application.Run; 20 | end. 21 | 22 | -------------------------------------------------------------------------------- /examples/nongui/oauth2test.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="11"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasCreateFormStatements Value="False"/> 9 | <MainUnitHasScaledStatement Value="False"/> 10 | </Flags> 11 | <SessionStorage Value="InProjectDir"/> 12 | <MainUnit Value="0"/> 13 | <Title Value="OAuth2 Testing"/> 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <MacroValues Count="1"> 18 | <Macro1 Name="LCLWidgetType" Value="nogui"/> 19 | </MacroValues> 20 | <BuildModes Count="1"> 21 | <Item1 Name="Default" Default="True"/> 22 | <SharedMatrixOptions Count="1"> 23 | <Item1 ID="183979494933" Modes="Default" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/> 24 | </SharedMatrixOptions> 25 | </BuildModes> 26 | <PublishOptions> 27 | <Version Value="2"/> 28 | <UseFileFilters Value="True"/> 29 | </PublishOptions> 30 | <RunParams> 31 | <FormatVersion Value="2"/> 32 | <Modes Count="0"/> 33 | </RunParams> 34 | <RequiredPackages Count="1"> 35 | <Item1> 36 | <PackageName Value="oauth2_laz"/> 37 | </Item1> 38 | </RequiredPackages> 39 | <Units Count="1"> 40 | <Unit0> 41 | <Filename Value="oauth2test.lpr"/> 42 | <IsPartOfProject Value="True"/> 43 | </Unit0> 44 | </Units> 45 | </ProjectOptions> 46 | <CompilerOptions> 47 | <Version Value="11"/> 48 | <PathDelim Value="\"/> 49 | <Target> 50 | <Filename Value="oauth2test"/> 51 | </Target> 52 | <SearchPaths> 53 | <IncludeFiles Value="$(ProjOutDir)"/> 54 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 55 | </SearchPaths> 56 | <Other> 57 | <CustomOptions Value="-dUseCThreads"/> 58 | </Other> 59 | </CompilerOptions> 60 | <Debugging> 61 | <Exceptions Count="3"> 62 | <Item1> 63 | <Name Value="EAbort"/> 64 | </Item1> 65 | <Item2> 66 | <Name Value="ECodetoolError"/> 67 | </Item2> 68 | <Item3> 69 | <Name Value="EFOpenError"/> 70 | </Item3> 71 | </Exceptions> 72 | </Debugging> 73 | </CONFIG> 74 | -------------------------------------------------------------------------------- /examples/nongui/oauth2test.lpr: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the MWA Software OAuth2 Client. 3 | 4 | The MWA Software OAuth2 Client is free software: you can redistribute it 5 | and/or modify it under the terms of the GNU Lesser General Public License as 6 | published by the Free Software Foundation, either version 3 of the License, or 7 | (at your option) any later version. 8 | 9 | The MWA Software OAuth2 Client is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU Lesser General Public License for more details. 13 | 14 | You should have received a copy of the GNU Lesser General Public License 15 | along with the MWA Software OAuth2 Client. If not, see <https://www.gnu.org/licenses/>. 16 | } 17 | program oauth2test; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | uses 22 | {$IFDEF UNIX} 23 | cthreads, 24 | {$ENDIF} 25 | Classes, SysUtils, CustApp, 26 | { you can add units after this } 27 | oauth2Client, oauth2tokens,URIParser; 28 | 29 | const 30 | {User for Resource Owner Password Grant} 31 | UserName = 'atester'; 32 | Password = 'test2021'; 33 | 34 | type 35 | 36 | { OAuth2ConsoleTest } 37 | 38 | OAuth2ConsoleTest = class(TCustomApplication) 39 | private 40 | FOAuth2Client: TOAuth2Client; 41 | FRefreshToken: string; 42 | procedure UpdateEndPoints; 43 | procedure TestExtensionGrant(Scope: string); 44 | protected 45 | procedure DoRun; override; 46 | public 47 | constructor Create(TheOwner: TComponent); override; 48 | destructor Destroy; override; 49 | procedure DoTests(scope: string); 50 | procedure WriteHelp; virtual; 51 | end; 52 | 53 | { OAuth2ConsoleTest } 54 | 55 | procedure OAuth2ConsoleTest.DoTests(scope: string); 56 | var AccessToken: AnsiString; 57 | RefreshToken: AnsiString; 58 | expires_in: integer; 59 | TokenScope: AnsiString; 60 | NewRefreshToken: string; 61 | begin 62 | writeln('Get Client Credentials'); 63 | try 64 | FOAuth2Client.GrantClientCredentials(scope,AccessToken,TokenScope,expires_in); 65 | writeln('Get Client Credentials: Access Token = "' + AccessToken + '"'); 66 | writeln('Expires In = ' + IntToStr(expires_in) + ' seconds, Scope = ' + TokenScope); 67 | except on E: Exception do 68 | writeln('Error: ' + E.message); 69 | end; 70 | 71 | writeln('Test Extension Grant using Get Client Credentials'); 72 | TestExtensionGrant(scope); 73 | 74 | writeln('Get User Password Credentials'); 75 | try 76 | FOAuth2Client.GrantUserPasswordCredentials(scope,UserName,Password, 77 | AccessToken,RefreshToken,TokenScope,expires_in); 78 | writeln('Get User Password Credentials: Access Token = "' + AccessToken + '"'); 79 | writeln('Refresh Token = ' + RefreshToken + '"'); 80 | writeln('Expires In = ' + IntToStr(expires_in) + ' seconds, Scope = ' + TokenScope); 81 | if RefreshToken <> '' then 82 | FRefreshToken := RefreshToken; 83 | except on E: Exception do 84 | writeln('Error: ' + E.message); 85 | end; 86 | 87 | if FRefreshToken <> '' then 88 | begin 89 | writeln('Refresh Token'); 90 | try 91 | FOAuth2Client.RefreshAccessToken('',FRefreshToken,AccessToken,TokenScope,NewRefreshToken,expires_in); 92 | writeln('Refresh Token: Access Token = "' + AccessToken + '" ' + 93 | 'Replacement Refresh Token = "' + NewRefreshToken + '" Expires In =' + 94 | IntToStr(expires_in) + ' seconds, Scope = ' + TokenScope); 95 | if NewRefreshToken <> '' then 96 | FRefreshToken := NewRefreshToken; 97 | except on E: Exception do 98 | writeln('Error: ' + E.message); 99 | end; 100 | end 101 | else 102 | writeln('No Refresh Token'); 103 | 104 | writeln('Get Authorization Grant'); 105 | try 106 | FOAuth2Client.GrantAuthorizationCode(scope,AccessToken,RefreshToken,TokenScope,expires_in); 107 | writeln('Get Authorization Grant Credentials: Access Token = "' + AccessToken + '"'); 108 | writeln('Refresh Token = ' + RefreshToken + '"'); 109 | writeln('Expires In = ' + IntToStr(expires_in) + ' seconds, Scope = ' + TokenScope); 110 | if RefreshToken <> '' then 111 | FRefreshToken := RefreshToken; 112 | except on E: Exception do 113 | writeln('Error: ' + E.message); 114 | end; 115 | 116 | writeln('Get Implicit Grant'); 117 | try 118 | FOAuth2Client.ImplicitGrant(scope,AccessToken,TokenScope,expires_in); 119 | writeln('Get Implicit Grant Credentials: Access Token = "' + AccessToken + '"'); 120 | writeln('Expires In = ' + IntToStr(expires_in) + ' seconds, Scope = ' + TokenScope); 121 | if RefreshToken <> '' then 122 | FRefreshToken := RefreshToken; 123 | except on E: Exception do 124 | writeln('Error: ' + E.message); 125 | end; 126 | end; 127 | 128 | procedure OAuth2ConsoleTest.UpdateEndPoints; 129 | var ENVURI,EndpointURI: TURI; 130 | AuthServer: string; 131 | begin 132 | AuthServer := GetEnvironmentVariable('AUTHSERVER'); 133 | if AuthServer <> '' then 134 | begin 135 | ENVURI := ParseURI(AuthServer); 136 | EndpointURI := ParseURI(FOAuth2Client.AuthEndPoint); 137 | EndpointURI.Protocol := ENVURI.Protocol; 138 | EndpointURI.Host := ENVURI.Host; 139 | FOAuth2Client.AuthEndPoint := EncodeURI(EndpointURI); 140 | EndpointURI := ParseURI(FOAuth2Client.TokenEndPoint); 141 | EndpointURI.Protocol := ENVURI.Protocol; 142 | EndpointURI.Host := ENVURI.Host; 143 | FOAuth2Client.TokenEndPoint := EncodeURI(EndpointURI); 144 | end; 145 | writeln('Auth End Point = ' + FOAuth2Client.AuthEndPoint); 146 | writeln('Token End Point = ' + FOAuth2Client.TokenEndPoint); 147 | end; 148 | 149 | procedure OAuth2ConsoleTest.TestExtensionGrant(Scope: string); 150 | var Response: TOAuth2BearerTokenResponse; 151 | LocalParams: TStringList; 152 | begin 153 | {Test emulates a Client credentials Grant using an ExtensionGrant} 154 | LocalParams := TStringList.Create; 155 | Response := TOAuth2BearerTokenResponse.Create; 156 | try 157 | LocalParams.Values['scope'] := Scope; 158 | try 159 | FOAuth2Client.ExtensionGrant('client_credentials',LocalParams,Response); 160 | writeln('Get Client Credentials using Extension Grant: Access Token = "' + Response.access_token + '"'); 161 | writeln('Expires In = ' + IntToStr(Response.expires_in) + ' seconds, Scope = ' + Response.scope); 162 | except on E: Exception do 163 | writeln('Error: ' + E.message); 164 | end; 165 | finally 166 | Response.Free; 167 | LocalParams.Free; 168 | end; 169 | end; 170 | 171 | procedure OAuth2ConsoleTest.DoRun; 172 | var 173 | ErrorMsg: String; 174 | begin 175 | // quick check parameters 176 | ErrorMsg := CheckOptions('h', 'help'); 177 | if ErrorMsg <> '' then begin 178 | ShowException(Exception.Create(ErrorMsg)); 179 | Terminate; 180 | Exit; 181 | end; 182 | 183 | // parse parameters 184 | if HasOption('h', 'help') then begin 185 | WriteHelp; 186 | Terminate; 187 | Exit; 188 | end; 189 | 190 | { add your program here } 191 | 192 | // stop program loop 193 | Terminate; 194 | end; 195 | 196 | constructor OAuth2ConsoleTest.Create(TheOwner: TComponent); 197 | begin 198 | inherited Create(TheOwner); 199 | StopOnException := True; 200 | FOAuth2Client := TOAuth2Client.Create(self); 201 | FOAuth2Client.AuthEndPoint := 'http://localhost/oauth2/authorise.php'; 202 | FOAuth2Client.TokenEndPoint := 'http://localhost/oauth2/token.php'; 203 | FOAuth2Client.ClientID := 'OAuth2Tester'; 204 | FOAuth2Client.ClientSecret := 'masterkey'; 205 | UpdateEndPoints; 206 | end; 207 | 208 | destructor OAuth2ConsoleTest.Destroy; 209 | begin 210 | inherited Destroy; 211 | end; 212 | 213 | procedure OAuth2ConsoleTest.WriteHelp; 214 | begin 215 | { add your help code here } 216 | writeln('Usage: ', ExeName, ' -h'); 217 | end; 218 | 219 | var 220 | Application: OAuth2ConsoleTest; 221 | begin 222 | Application := OAuth2ConsoleTest.Create(nil); 223 | Application.Title:='OAuth2 Testing'; 224 | Application.Run; 225 | Application.DoTests('testing'); 226 | Application.DoTests('bad'); 227 | Application.Free; 228 | end. 229 | 230 | -------------------------------------------------------------------------------- /examples/server/endpoints/authorise.php: -------------------------------------------------------------------------------- 1 | <?php 2 | // include our OAuth2 Server object 3 | require_once __DIR__.'/../server.php'; 4 | 5 | $request = OAuth2\Request::createFromGlobals(); 6 | $response = new OAuth2\Response(); 7 | 8 | // validate the authorize request 9 | if (!$server->validateAuthorizeRequest($request, $response)) { 10 | $response->send(); 11 | die; 12 | } 13 | // display an authorization form 14 | if (empty($_POST)) { 15 | exit(' 16 | <form method="post"> 17 | <label>Do You Authorize TestClient?</label><br /> 18 | <input type="submit" name="authorized" value="yes"> 19 | <input type="submit" name="authorized" value="no"> 20 | </form>'); 21 | } 22 | 23 | // print the authorization code if the user has authorized your client 24 | $is_authorized = ($_POST['authorized'] === 'yes'); 25 | $server->handleAuthorizeRequest($request, $response, $is_authorized); 26 | $response->send(); 27 | 28 | -------------------------------------------------------------------------------- /examples/server/endpoints/resource.php: -------------------------------------------------------------------------------- 1 | <?php 2 | // include our OAuth2 Server object 3 | require_once __DIR__.'/../server.php'; 4 | 5 | // Handle a request to a resource and authenticate the access token 6 | if (!$server->verifyResourceRequest(OAuth2\Request::createFromGlobals())) { 7 | $server->getResponse()->send(); 8 | die; 9 | } 10 | echo json_encode(array('success' => true, 'message' => 'You accessed my APIs!')); 11 | -------------------------------------------------------------------------------- /examples/server/endpoints/token.php: -------------------------------------------------------------------------------- 1 | <?php 2 | 3 | // include our OAuth2 Server object 4 | require_once __DIR__.'/../server.php'; 5 | // Handle a request for an OAuth2.0 Access Token and send the response to the client 6 | $server->handleTokenRequest(OAuth2\Request::createFromGlobals())->send(); 7 | -------------------------------------------------------------------------------- /examples/server/schema.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE oauth_clients ( 2 | client_id VARCHAR(80) NOT NULL, 3 | client_secret VARCHAR(80), 4 | redirect_uri VARCHAR(2000), 5 | grant_types VARCHAR(80), 6 | scope VARCHAR(4000), 7 | user_id VARCHAR(80), 8 | PRIMARY KEY (client_id) 9 | ); 10 | 11 | CREATE TABLE oauth_access_tokens ( 12 | access_token VARCHAR(40) NOT NULL, 13 | client_id VARCHAR(80) NOT NULL, 14 | user_id VARCHAR(80), 15 | expires TIMESTAMP NOT NULL, 16 | scope VARCHAR(4000), 17 | PRIMARY KEY (access_token) 18 | ); 19 | 20 | CREATE TABLE oauth_authorization_codes ( 21 | authorization_code VARCHAR(40) NOT NULL, 22 | client_id VARCHAR(80) NOT NULL, 23 | user_id VARCHAR(80), 24 | redirect_uri VARCHAR(2000), 25 | expires TIMESTAMP NOT NULL, 26 | scope VARCHAR(4000), 27 | id_token VARCHAR(1000), 28 | PRIMARY KEY (authorization_code) 29 | ); 30 | 31 | CREATE TABLE oauth_refresh_tokens ( 32 | refresh_token VARCHAR(40) NOT NULL, 33 | client_id VARCHAR(80) NOT NULL, 34 | user_id VARCHAR(80), 35 | expires TIMESTAMP NOT NULL, 36 | scope VARCHAR(4000), 37 | PRIMARY KEY (refresh_token) 38 | ); 39 | 40 | CREATE TABLE oauth_users ( 41 | username VARCHAR(80), 42 | password VARCHAR(80), 43 | first_name VARCHAR(80), 44 | last_name VARCHAR(80), 45 | email VARCHAR(80), 46 | email_verified BOOLEAN, 47 | scope VARCHAR(4000), 48 | PRIMARY KEY (username) 49 | ); 50 | 51 | CREATE TABLE oauth_scopes ( 52 | scope VARCHAR(80) NOT NULL, 53 | is_default BOOLEAN, 54 | PRIMARY KEY (scope) 55 | ); 56 | 57 | CREATE TABLE oauth_jwt ( 58 | client_id VARCHAR(80) NOT NULL, 59 | subject VARCHAR(80), 60 | public_key VARCHAR(2000) NOT NULL 61 | ); 62 | INSERT INTO oauth_clients (client_id, client_secret, redirect_uri) VALUES ("OAuth2Tester", "masterkey", "http://localhost:8080"); 63 | commit; 64 | 65 | 66 | -------------------------------------------------------------------------------- /examples/server/server.php: -------------------------------------------------------------------------------- 1 | <?php 2 | //Set DB Name, User and password 3 | require_once('config.php'); 4 | 5 | // error reporting (this is a demo, after all!) 6 | ini_set('display_errors',1);error_reporting(E_ALL); 7 | 8 | // Autoloading (composer is preferred, but for this example let's just do this) 9 | require_once('oauth2-server-php/src/OAuth2/Autoloader.php'); 10 | OAuth2\Autoloader::register(); 11 | 12 | // $dsn is the Data Source Name for your database, for exmaple "mysql:dbname=my_oauth2_db;host=localhost" 13 | $storage = new OAuth2\Storage\Pdo(array('dsn' => $dsn, 'username' => $username, 'password' => $password)); 14 | 15 | // Pass a storage object or array of storage objects to the OAuth2 server class 16 | $server = new OAuth2\Server($storage,array('allow_implicit' => true)); 17 | 18 | // Add the "Client Credentials" grant type (it is the simplest of the grant types) 19 | $server->addGrantType(new OAuth2\GrantType\ClientCredentials($storage),array( 20 | 'allow_credentials_in_request_body' => true 21 | )); 22 | 23 | // Add the "Authorization Code" grant type (this is where the oauth magic happens) 24 | $server->addGrantType(new OAuth2\GrantType\AuthorizationCode($storage),array( 25 | 'allow_credentials_in_request_body' => true 26 | )); 27 | 28 | $server->addGrantType(new OAuth2\GrantType\RefreshToken($storage),array( 29 | 'allow_credentials_in_request_body' => true 30 | )); 31 | 32 | // create some users in memory 33 | $users = array('atester' => array('password' => 'test2021', 'first_name' => 'Anon', 'last_name' => 'Tester')); 34 | 35 | // create a storage object for user list 36 | $mstorage = new OAuth2\Storage\Memory(array('user_credentials' => $users)); 37 | 38 | // add User Credentials Grant 39 | $server->addGrantType(new OAuth2\GrantType\UserCredentials($mstorage)); 40 | 41 | $defaultScope = 'basic'; 42 | $supportedScopes = array( 43 | 'basic', 44 | 'testing' 45 | ); 46 | $memory = new OAuth2\Storage\Memory(array( 47 | 'default_scope' => $defaultScope, 48 | 'supported_scopes' => $supportedScopes 49 | )); 50 | $scopeUtil = new OAuth2\Scope($memory); 51 | 52 | $server->setScopeUtil($scopeUtil); 53 | 54 | -------------------------------------------------------------------------------- /examples/server/setup.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | USERNAME=oauth2 3 | PASSWORD=4uZdvKaM 4 | DB=oauth2_db 5 | 6 | cd `dirname $0` 7 | 8 | if [ ! -d "oauth2-server-php" ]; then 9 | git clone https://github.com/bshaffer/oauth2-server-php.git -b master 10 | fi 11 | 12 | ( 13 | echo "DROP DATABASE IF EXISTS $DB;" 14 | echo "CREATE DATABASE $DB CHARACTER SET utf8;" 15 | echo "DROP USER IF EXISTS '$USERNAME'@'localhost';" 16 | echo "CREATE USER '$USERNAME'@'localhost' IDENTIFIED BY '$PASSWORD';" 17 | echo "GRANT ALL on $DB.* to '$USERNAME'@'localhost';" 18 | echo "commit;" 19 | echo "use $DB;" 20 | cat schema.sql 21 | )|mysql -uroot -p 22 | 23 | #Create Config.php 24 | (echo "<?php" 25 | echo "\$dsn = 'mysql:dbname=$DB;host=localhost';" 26 | echo "\$username = 'oauth2';" 27 | echo "\$password = '$PASSWORD';" 28 | ) >config.php 29 | 30 | #Create (example) apache config fragment 31 | DIR=`realpath .` 32 | ( 33 | echo "Alias \"/oauth2/\" \"$DIR/endpoints/\"" 34 | echo "<Directory \"$DIR\">" 35 | echo "php_value engine on" 36 | echo "allow from all" 37 | echo "</Directory>" 38 | ) > "apache2.conf" 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /examples/server/testserver.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | SERVER=localhost 3 | echo "Client Credentials Grant" 4 | curl http://$SERVER/oauth2/token.php -d 'client_id=OAuth2Tester&client_secret=masterkey&grant_type=client_credentials' 5 | echo "Resource Owner Password Credentials Grant" 6 | curl http://$SERVER/oauth2/token.php -d 'client_id=OAuth2Tester&client_secret=masterkey&grant_type=password&username=atester&password=test2021' 7 | 8 | 9 | -------------------------------------------------------------------------------- /images/oauth2client.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MWASoftware/oauth2client/3c30d2e09d17452d8fbfe4a7cf7240bb3f68c952/images/oauth2client.png -------------------------------------------------------------------------------- /languages/oauth2Client.pot: -------------------------------------------------------------------------------- 1 | msgid "" 2 | msgstr "Content-Type: text/plain; charset=UTF-8" 3 | 4 | #: oauth2client.snojavascriptsupport 5 | msgid "Implicit Authorization Failed. Please enable Javascript." 6 | msgstr "" 7 | 8 | #: oauth2client.soauth2accessauthorized 9 | msgid "Access Authorized" 10 | msgstr "" 11 | 12 | #: oauth2client.soauth2accessfailed 13 | msgid "Access Authorization Request Failed" 14 | msgstr "" 15 | 16 | #: oauth2client.soauth2requestignored 17 | msgid "Authorization Code Request Ignored" 18 | msgstr "" 19 | 20 | -------------------------------------------------------------------------------- /languages/oauth2errors.pot: -------------------------------------------------------------------------------- 1 | msgid "" 2 | msgstr "Content-Type: text/plain; charset=UTF-8" 3 | 4 | #: oauth2errors.sauthtimeout 5 | msgid "Authorization Grant Timeout" 6 | msgstr "" 7 | 8 | #: oauth2errors.sbadaccesstokentype 9 | #, object-pascal-format 10 | msgid "Unexpected Access Token Type - expected %s found %s" 11 | msgstr "" 12 | 13 | #: oauth2errors.screateguidfailed 14 | msgid "Create GUID Failed" 15 | msgstr "" 16 | 17 | #: oauth2errors.sinvalidpropertytype 18 | #, object-pascal-format 19 | msgid "Unsupported property type or value for property %s - value = \"%s\"" 20 | msgstr "" 21 | 22 | #: oauth2errors.smissingaccesstoken 23 | msgid "Access Token not present in response" 24 | msgstr "" 25 | 26 | #: oauth2errors.smissingauthcode 27 | msgid "No Authorisation Code contained in response to authorisation code request" 28 | msgstr "" 29 | 30 | #: oauth2errors.snotmainthread 31 | msgid "Method must be called from the main thread only" 32 | msgstr "" 33 | 34 | #: oauth2errors.soauth2clientnotidle 35 | msgid "OAuth2 Client is not idle" 36 | msgstr "" 37 | 38 | #: oauth2errors.soauth2responseerror 39 | #, object-pascal-format 40 | msgid "Status Code %d %s - OAuth2 Error (%s) %s" 41 | msgstr "" 42 | 43 | #: oauth2errors.soautherrormessage 44 | #, object-pascal-format 45 | msgid "Authorisation Code Request Error - %s - %s" 46 | msgstr "" 47 | 48 | #: oauth2errors.sopenurlfailed 49 | #, object-pascal-format 50 | msgid "Call to OpenURL Failed for %s" 51 | msgstr "" 52 | 53 | #: oauth2errors.south2otherexception 54 | #, object-pascal-format 55 | msgid "Status Code %d - Unknown OAuth2 Error" 56 | msgstr "" 57 | 58 | #: oauth2errors.sunexpectedstate 59 | #, object-pascal-format 60 | msgid "Unexpected State Parameter - attempt at forgery? Expected \"%s\", received \"%s\"" 61 | msgstr "" 62 | 63 | -------------------------------------------------------------------------------- /oauth2_laz.lpk: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <Package Version="5"> 4 | <Name Value="oauth2_laz"/> 5 | <Type Value="RunAndDesignTime"/> 6 | <Author Value="Tony Whyman"/> 7 | <CompilerOptions> 8 | <Version Value="11"/> 9 | <SearchPaths> 10 | <OtherUnitFiles Value="src"/> 11 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 12 | </SearchPaths> 13 | </CompilerOptions> 14 | <License Value=" 15 | This file is part of this MWA Software OAuth2 Client. 16 | 17 | The MWA Software OAuth2 Client is free software: you can redistribute it 18 | and/or modify it under the terms of the GNU Lesser General Public License as 19 | published by the Free Software Foundation, either version 3 of the License, or 20 | (at your option) any later version. 21 | 22 | The MWA Software OAuth2 Client is distributed in the hope that it will be useful, 23 | but WITHOUT ANY WARRANTY; without even the implied warranty of 24 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 25 | GNU Lesser General Public License for more details. 26 | 27 | You should have received a copy of the GNU Lesser General Public License 28 | along with the MWA Software OAuth2 Client. If not, see https://www.gnu.org/licenses/. 29 | 30 | "/> 31 | <Version Major="1" Build="9999"/> 32 | <Files Count="3"> 33 | <Item1> 34 | <Filename Value="src/oauth2Client.pas"/> 35 | <HasRegisterProc Value="True"/> 36 | <UnitName Value="oauth2Client"/> 37 | </Item1> 38 | <Item2> 39 | <Filename Value="src/oauth2errors.pas"/> 40 | <UnitName Value="oauth2errors"/> 41 | </Item2> 42 | <Item3> 43 | <Filename Value="src/oauth2tokens.pas"/> 44 | <UnitName Value="oauth2tokens"/> 45 | </Item3> 46 | </Files> 47 | <CompatibilityMode Value="True"/> 48 | <i18n> 49 | <EnableI18N Value="True"/> 50 | <OutDir Value="languages"/> 51 | </i18n> 52 | <RequiredPkgs Count="2"> 53 | <Item1> 54 | <PackageName Value="LCLBase"/> 55 | </Item1> 56 | <Item2> 57 | <PackageName Value="indyopenssl"/> 58 | </Item2> 59 | </RequiredPkgs> 60 | <UsageOptions> 61 | <UnitPath Value="$(PkgOutDir)"/> 62 | </UsageOptions> 63 | <PublishOptions> 64 | <Version Value="2"/> 65 | <UseFileFilters Value="True"/> 66 | </PublishOptions> 67 | </Package> 68 | </CONFIG> 69 | -------------------------------------------------------------------------------- /oauth2_laz.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit oauth2_laz; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | oauth2Client, oauth2errors, oauth2tokens, LazarusPackageIntf; 12 | 13 | implementation 14 | 15 | procedure Register; 16 | begin 17 | RegisterUnit('oauth2Client', @oauth2Client.Register); 18 | end; 19 | 20 | initialization 21 | RegisterPackage('oauth2_laz', @Register); 22 | end. 23 | -------------------------------------------------------------------------------- /src/oauth2Client.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the MWA Software OAuth2 Client. 3 | 4 | The MWA Software OAuth2 Client is free software: you can redistribute it 5 | and/or modify it under the terms of the GNU Lesser General Public License as 6 | published by the Free Software Foundation, either version 3 of the License, or 7 | (at your option) any later version. 8 | 9 | The MWA Software OAuth2 Client is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU Lesser General Public License for more details. 13 | 14 | You should have received a copy of the GNU Lesser General Public License 15 | along with the MWA Software OAuth2 Client. If not, see <https://www.gnu.org/licenses/>. 16 | } 17 | unit oauth2Client; 18 | 19 | { See RFC 6749 The OAuth 2.0 Authorization Framework 20 | 21 | This class implements the: 22 | * Authorization Code Grant 23 | * Client Credentials Grant 24 | * Refreshing an Access Token 25 | * Resource Owner Password Credentials Grant 26 | * Implicit Grant 27 | * Extension Grant 28 | 29 | It uses the System Browser for supporting an Authorization Code Grant and 30 | an Implicit Grant, and an embedded HTTPS server running as a separate thread. 31 | } 32 | 33 | {$mode ObjFPC}{$H+} 34 | { $DEFINE USING_INDY10_6} {Enable this if using the legacy version of Indy with OpenSSL 1.0.2 or earler} 35 | 36 | interface 37 | 38 | uses Classes, Sysutils, IdHTTPServer, IdGlobal, IdContext,IdHeaderList, 39 | IdCustomHTTPServer, SyncObjs, oauth2tokens, oauth2errors; 40 | 41 | 42 | type 43 | TOAuth2BrowserResponseType = (rtSuccess,rtError,rtIgnored,rtRedirect); 44 | TOAuth2OnGetBrowserResponseBody = procedure(Sender: TObject; ResponseType: TOAuth2BrowserResponseType; Contents: TMemoryStream) of object; 45 | TOAuth2OnErrorResponse = procedure(Sender: TObject; E: Exception) of object; 46 | TOAuth2OnAccessTokenExt = procedure(Sender: TObject; Response: TOAuth2TokenResponse) of object; 47 | TOAuth2OnAccessToken = procedure(Sender: TObject; AccessToken, RefreshToken, TokenScope: string; 48 | expires_in: integer) of object; 49 | 50 | TOAuth2AuthGrantState = (agIdle,agWaitAuthCode,agWaitRedirect,agWaitAccessCode,agWaitSessionEnd); 51 | 52 | TOAuth2ClientAuthType = (caBasic,caInline); 53 | 54 | 55 | { TOAuth2Client } 56 | 57 | TOAuth2Client = class(TComponent) 58 | private type 59 | 60 | { TResponseHandler } 61 | 62 | TResponseHandler = class 63 | protected 64 | FResponse: TOAuth2TokenResponse; 65 | public 66 | procedure AccessTokenReceived; virtual; abstract; 67 | procedure ErrorResponseReceived(E: Exception); virtual; abstract; 68 | procedure GrantCompleted; virtual; abstract; 69 | property Response: TOAuth2TokenResponse read FResponse; 70 | end; 71 | 72 | { TAsyncResponseHandler } 73 | 74 | TAsyncResponseHandler = class(TResponseHandler) 75 | private 76 | FOwner: TOAuth2Client; 77 | FThreadException: Exception; 78 | procedure DoOnAccessToken; 79 | procedure DoOnErrorResponse; 80 | public 81 | constructor Create(aOwner: TOAuth2Client; ResponseClass: TOAuth2TokenResponseClass); 82 | destructor Destroy; override; 83 | procedure AccessTokenReceived; override; 84 | procedure ErrorResponseReceived(E: Exception); override; 85 | procedure GrantCompleted; override; 86 | end; 87 | 88 | { TSyncResponseHandler } 89 | 90 | TSyncResponseHandler = class(TResponseHandler) 91 | private 92 | FOwner: TOAuth2Client; 93 | FHasException: boolean; 94 | FErrorData: TOAuth2ErrorData; 95 | FUserEventObject: TEventObject; 96 | public 97 | constructor Create(aOwner: TOAuth2Client; aResponse: TOAuth2TokenResponse); 98 | destructor Destroy; override; 99 | procedure AccessTokenReceived; override; 100 | procedure ErrorResponseReceived(E: Exception); override; 101 | procedure GrantCompleted; override; 102 | function WaitFor(timeout: cardinal): TWaitResult; 103 | end; 104 | 105 | { TServerStopThread } 106 | 107 | TServerStopThread = class(TThread) 108 | private 109 | FOwner: TOAuth2Client; 110 | protected 111 | procedure Execute; override; 112 | public 113 | constructor Create(Owner: TOAuth2Client); 114 | end; 115 | 116 | private 117 | FAuthEndPoint: string; 118 | FClientAuthType: TOAuth2ClientAuthType; 119 | FClientID: string; 120 | FClientSecret: string; 121 | FOnAccessToken: TOAuth2OnAccessToken; 122 | FOnAccessTokenExt: TOAuth2OnAccessTokenExt; 123 | FOnErrorResponse: TOAuth2OnErrorResponse; 124 | FOnGetBrowserResponseBody: TOAuth2OnGetBrowserResponseBody; 125 | FRedirectURI: string; 126 | FTokenEndPoint: string; 127 | FServer: TIdHTTPServer; 128 | FState: string; 129 | FAuthGrantState: TOAuth2AuthGrantState; 130 | FSettingPort: boolean; 131 | FResponseHandler: TResponseHandler; 132 | procedure CheckMainThread; 133 | function GetPortNo: TIdPort; 134 | procedure SetPortNo(AValue: TIdPort); 135 | procedure HandleCommandGet(AContext: TIdContext; 136 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 137 | procedure HandleDisconnect(AContext: TIdContext); 138 | procedure InternalGrantAuthorizationCode(Scope: string); 139 | procedure InternalImplicitGrant(Scope: string); 140 | procedure GetAccessTokenFromAuthCode(AuthCode: string; Response: TOAuth2TokenResponse); 141 | function Post(URL: string; Params: TStrings; Response: TOAuth2Response): integer; 142 | procedure ResetServer; 143 | procedure setRedirectURI(AValue: string); 144 | protected 145 | function BuildImplicitGrantRedirectPage: string; virtual; 146 | public 147 | constructor Create(aComponent: TComponent); override; 148 | destructor Destroy; override; 149 | procedure GrantClientCredentials(Scope: string; 150 | var AccessToken: string; var TokenScope: string; var expires_in: integer); overload; 151 | procedure GrantClientCredentials(Scope: string; Response: TOAuth2TokenResponse); overload; 152 | procedure GrantUserPasswordCredentials(Scope: string; 153 | UserName, Password: string; var AccessToken: string; var RefreshToken: string; 154 | var TokenScope: string; var expires_in: integer); overload; 155 | procedure GrantUserPasswordCredentials(Scope: string; 156 | UserName, Password: string; 157 | Response: TOAuth2TokenResponse); overload; 158 | procedure GrantAuthorizationCodeAsync(Scope: string; ResponseClass: TOAuth2TokenResponseClass); overload; 159 | procedure GrantAuthorizationCodeAsync(Scope: string); overload; 160 | procedure GrantAuthorizationCode(Scope: string; var AccessToken, 161 | RefreshToken: string; var TokenScope: string; var expires_in: integer; timeout: cardinal=INFINITE); overload; 162 | procedure GrantAuthorizationCode(Scope: string; Response: TOAuth2TokenResponse; timeout: cardinal=INFINITE); overload; 163 | procedure ImplicitGrantAsync(Scope: string; ResponseClass: TOAuth2TokenResponseClass); overload; 164 | procedure ImplicitGrantAsync(Scope: string); overload; 165 | procedure ImplicitGrant(Scope: string; 166 | var AccessToken: string; var TokenScope: string; var expires_in: integer; timeout: cardinal=INFINITE); overload; 167 | procedure ImplicitGrant(Scope: string; Response: TOAuth2TokenResponse; timeout: cardinal=INFINITE); overload; 168 | procedure CancelGrantRequest; 169 | procedure RefreshAccessToken(Scope, RefreshToken: string; var AccessToken: string; 170 | var TokenScope: string; var NewRefreshToken: string; var expires_in: integer); overload; 171 | procedure RefreshAccessToken(Scope, RefreshToken: string; Response: TOAuth2TokenResponse); overload; 172 | procedure ExtensionGrant(GrantType: string; aParams: TStrings; 173 | Response: TOAuth2TokenResponse); 174 | published 175 | property ClientID: string read FClientID write FClientID; 176 | property ClientSecret: string read FClientSecret write FClientSecret; 177 | property AuthEndPoint: string read FAuthEndPoint write FAuthEndPoint; 178 | property TokenEndPoint: string read FTokenEndPoint write FTokenEndPoint; 179 | property ClientAuthType: TOAuth2ClientAuthType read FClientAuthType write FClientAuthType; {Default to caInline} 180 | property RedirectURI: string read FRedirectURI write setRedirectURI; 181 | property PortNo: TIdPort read GetPortNo write SetPortNo; {Defaults to 8080} 182 | property OnAccessTokenExt: TOAuth2OnAccessTokenExt read FOnAccessTokenExt write FOnAccessTokenExt; 183 | property OnAccessToken: TOAuth2OnAccessToken read FOnAccessToken write FOnAccessToken; 184 | property OnErrorResponse: TOAuth2OnErrorResponse read FOnErrorResponse write FOnErrorResponse; 185 | property OnGetBrowserResponseBody: TOAuth2OnGetBrowserResponseBody read FOnGetBrowserResponseBody write FOnGetBrowserResponseBody; 186 | end; 187 | 188 | { TOAuth2TextBuffer } 189 | 190 | TOAuth2TextBuffer = class(TMemoryStream) 191 | private 192 | function GetDataString: AnsiString; 193 | public 194 | property DataString: AnsiString read GetDataString; 195 | end; 196 | 197 | { TOAuth2URLEncodedData } 198 | 199 | TOAuth2URLEncodedData = class(TOAuth2TextBuffer) 200 | public 201 | procedure AddParam(Name, Value: string); 202 | procedure AddParams(Params: TStrings); 203 | end; 204 | 205 | 206 | procedure Register; 207 | 208 | implementation 209 | 210 | uses IdHTTP, IdURI, IdSSL,IdSSLOpenSSL, IdLogEvent, IdGlobalProtocols, 211 | IdIntercept, LCLIntf, LResources, URIParser; 212 | 213 | const 214 | {Response Content Type} 215 | rcAccept = 'application/vnd.hmrc.1.0+json'; 216 | 217 | const 218 | RedirectResponse = 'window.location.href=window.location.origin+''?''+window.location.hash.substring(1);'; 219 | 220 | resourcestring 221 | {Default responses to Get Authorization Code/Implicit Grant dialog} 222 | SOAuth2AccessAuthorized = 'Access Authorized'; 223 | SOAuth2AccessFailed = 'Access Authorization Request Failed'; 224 | SOAuth2RequestIgnored = 'Authorization Code Request Ignored'; 225 | SNoJavascriptSupport = 'Implicit Authorization Failed. Please enable Javascript.'; 226 | 227 | { TOAuth2TextBuffer } 228 | 229 | function TOAuth2TextBuffer.GetDataString: AnsiString; 230 | begin 231 | SetLength(Result,Size); 232 | Position := 0; 233 | Read(Result[1],Size); 234 | SetCodePage(RawByteString(Result), DefaultSystemCodePage, False); 235 | end; 236 | 237 | { TOAuth2Client.TServerStopThread } 238 | 239 | procedure TOAuth2Client.TServerStopThread.Execute; 240 | begin 241 | FOwner.ResetServer; 242 | end; 243 | 244 | constructor TOAuth2Client.TServerStopThread.Create(Owner: TOAuth2Client); 245 | begin 246 | inherited Create(false); 247 | FOwner := Owner; 248 | FreeOnTerminate := true; 249 | end; 250 | 251 | { TOAuth2Client.TAsyncResponseHandler } 252 | 253 | procedure TOAuth2Client.TAsyncResponseHandler.DoOnAccessToken; 254 | begin 255 | with FOwner do 256 | begin 257 | if assigned(FOnAccessTokenExt) then 258 | OnAccessTokenExt(FOwner,Response) 259 | else 260 | if assigned(OnAccessToken) then 261 | begin 262 | if Response is TOAuth2BearerTokenResponse then 263 | with Response as TOAuth2BearerTokenResponse do 264 | OnAccessToken(FOwner,access_token,refresh_token,scope,expires_in) 265 | else 266 | if assigned(FOnErrorResponse) then 267 | try 268 | OAuth2Error(erBadAccessTokenType,['bearer',Response.token_type]); 269 | except on E: Exception do 270 | OnErrorResponse(self,E); 271 | end; 272 | end; 273 | end; 274 | end; 275 | 276 | procedure TOAuth2Client.TAsyncResponseHandler.DoOnErrorResponse; 277 | begin 278 | if assigned(FOwner.FOnErrorResponse) then 279 | FOwner.FOnErrorResponse(FOwner,FThreadException); 280 | end; 281 | 282 | constructor TOAuth2Client.TAsyncResponseHandler.Create(aOwner: TOAuth2Client; 283 | ResponseClass: TOAuth2TokenResponseClass); 284 | begin 285 | inherited Create; 286 | FOwner := aOwner; 287 | FResponse := ResponseClass.Create; 288 | end; 289 | 290 | destructor TOAuth2Client.TAsyncResponseHandler.Destroy; 291 | begin 292 | if FResponse <> nil then FResponse.Free; 293 | inherited Destroy; 294 | end; 295 | 296 | procedure TOAuth2Client.TAsyncResponseHandler.AccessTokenReceived; 297 | begin 298 | TThread.Synchronize(nil,@DoOnAccessToken); 299 | end; 300 | 301 | procedure TOAuth2Client.TAsyncResponseHandler.ErrorResponseReceived( 302 | E: Exception); 303 | begin 304 | FThreadException := E; 305 | try 306 | TThread.Synchronize(nil,@DoOnErrorResponse); 307 | finally 308 | FThreadException := nil; 309 | end; 310 | end; 311 | 312 | procedure TOAuth2Client.TAsyncResponseHandler.GrantCompleted; 313 | begin 314 | TServerStopThread.Create(FOwner); {Deactivate Server from separate thread} 315 | FreeAndNil(FOwner.FResponseHandler); {we're no longer needed} 316 | end; 317 | 318 | 319 | { TOAuth2Client.TSyncResponseHandler } 320 | 321 | constructor TOAuth2Client.TSyncResponseHandler.Create(aOwner: TOAuth2Client; 322 | aResponse: TOAuth2TokenResponse); 323 | begin 324 | inherited Create; 325 | FOwner := aOwner; 326 | FResponse := aResponse; 327 | FUserEventObject := TEventObject.Create(nil,false,false,'WaitForAccessCode'); 328 | end; 329 | 330 | destructor TOAuth2Client.TSyncResponseHandler.Destroy; 331 | begin 332 | if FUserEventObject <> nil then FUserEventObject.Free; 333 | inherited Destroy; 334 | end; 335 | 336 | procedure TOAuth2Client.TSyncResponseHandler.AccessTokenReceived; 337 | begin 338 | //Do Nothing 339 | end; 340 | 341 | procedure TOAuth2Client.TSyncResponseHandler.ErrorResponseReceived( 342 | E: Exception); 343 | begin 344 | FHasException := true; 345 | if E is EOAuth2Exception then 346 | (E as EOAuth2Exception).GetErrorData(FErrorData) 347 | else 348 | FErrorData.ErrorMessage := E.Message; 349 | FUserEventObject.SetEvent; 350 | end; 351 | 352 | procedure TOAuth2Client.TSyncResponseHandler.GrantCompleted; 353 | begin 354 | FUserEventObject.SetEvent; 355 | end; 356 | 357 | function TOAuth2Client.TSyncResponseHandler.WaitFor(timeout: cardinal): TWaitResult; 358 | begin 359 | Result := FUserEventObject.WaitFor(timeout); 360 | Sleep(100); {Give chance for server to fully complete} 361 | FOwner.ResetServer; 362 | if FHasException then 363 | begin 364 | if FErrorData.StatusCode = 0 then 365 | raise Exception.Create(FErrorData.ErrorMessage) 366 | else 367 | raise EOAuth2Exception.Create(FErrorData); 368 | end; 369 | end; 370 | 371 | 372 | { TOAuth2URLEncodedData } 373 | 374 | procedure TOAuth2URLEncodedData.AddParam(Name, Value: string); 375 | var s: string; 376 | begin 377 | s := Name+'='+TIdURI.ParamsEncode(Value); 378 | if Size <> 0 then 379 | s := '&' + s; 380 | WriteBuffer(s[1],Length(s)); 381 | end; 382 | 383 | procedure TOAuth2URLEncodedData.AddParams(Params: TStrings); 384 | var i: integer; 385 | begin 386 | for i := 0 to Params.Count - 1 do 387 | AddParam(Params.Names[i],Params.ValueFromIndex[i]); 388 | end; 389 | 390 | { TOAuth2Client.TBearerTokenResponse } 391 | 392 | { TOAuth2Client } 393 | 394 | procedure TOAuth2Client.CheckMainThread; 395 | begin 396 | if GetCurrentThreadID <> MainThreadID then 397 | OAuth2Error(erNotMainThread); 398 | end; 399 | 400 | function TOAuth2Client.GetPortNo: TIdPort; 401 | begin 402 | Result := FServer.DefaultPort; 403 | end; 404 | 405 | procedure TOAuth2Client.SetPortNo(AValue: TIdPort); 406 | var URI: TURI; 407 | begin 408 | FServer.DefaultPort := AValue; 409 | if FSettingPort then Exit; 410 | URI := ParseURI(RedirectURI); 411 | URI.Port := AValue; 412 | FRedirectURI := EncodeURI(URI); 413 | end; 414 | 415 | procedure TOAuth2Client.HandleCommandGet(AContext: TIdContext; 416 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 417 | 418 | var ResponseType: TOAuth2BrowserResponseType; 419 | 420 | procedure ValidateResponse; 421 | begin 422 | with ARequestInfo do 423 | begin 424 | {check state} 425 | if Params.Values['state'] <> FState then 426 | OAuth2Error(erUnexpectedState,[FState, Params.Values['state']]); 427 | FState := ''; 428 | {check for errors} 429 | if Params.Values['error'] <> '' then 430 | raise EOAuth2Exception.Create(Params); 431 | end; 432 | end; 433 | 434 | procedure ProcessAuthCode; 435 | var AuthCode: string; 436 | begin 437 | with ARequestInfo do 438 | begin 439 | {extract auth code} 440 | AuthCode := Params.Values['code']; 441 | if AuthCode = '' then 442 | OAuth2Error(erMissingAuthCode); 443 | FAuthGrantState := agWaitAccessCode; 444 | {Get access Code} 445 | GetAccessTokenFromAuthCode(AuthCode,FResponseHandler.Response); 446 | FResponseHandler.AccessTokenReceived; 447 | FAuthGrantState := agWaitSessionEnd; 448 | end; 449 | end; 450 | 451 | procedure ProcessAccessCode; 452 | begin 453 | with ARequestInfo do 454 | begin 455 | FResponseHandler.Response.ProcessParams(Params); 456 | FResponseHandler.AccessTokenReceived; 457 | FAuthGrantState := agWaitSessionEnd; 458 | end; 459 | end; 460 | 461 | var s: string; 462 | M: TMemoryStream; 463 | 464 | begin 465 | // writeln('Response: ',ARequestInfo.RawHeaders.Text); 466 | ResponseType := rtSuccess; 467 | try 468 | case FAuthGrantState of 469 | agWaitAuthCode: 470 | begin 471 | ValidateResponse; 472 | ProcessAuthCode; 473 | end; 474 | 475 | agWaitAccessCode: 476 | begin 477 | if ARequestInfo.Params.IndexOfName('error') <> -1 then 478 | raise EOAuth2Exception.Create(ARequestInfo.Params); 479 | ResponseType := rtRedirect; 480 | FAuthGrantState := agWaitRedirect; 481 | end; 482 | 483 | agWaitRedirect: 484 | begin 485 | if ARequestInfo.Params.Count = 0 then 486 | {assume browser refresh on javascript enable} 487 | ResponseType := rtRedirect 488 | else 489 | begin 490 | ValidateResponse; 491 | ProcessAccessCode; 492 | end; 493 | end; 494 | else 495 | ResponseType := rtIgnored; 496 | end; 497 | except on E: Exception do 498 | begin 499 | FResponseHandler.ErrorResponseReceived(E); 500 | FAuthGrantState := agWaitSessionEnd; 501 | ResponseType := rtError; 502 | end; 503 | end; 504 | AResponseInfo.ContentType := 'text/html'; 505 | AResponseInfo.ContentEncoding := 'UTF-8'; 506 | AResponseInfo.CharSet := 'UTF-8'; 507 | AResponseInfo.CloseConnection := true; 508 | M := TMemoryStream.Create; 509 | if assigned(FOnGetBrowserResponseBody) then 510 | FOnGetBrowserResponseBody(self,ResponseType,M); 511 | AResponseInfo.ContentStream := M; 512 | if AResponseInfo.ContentStream.Size = 0 then 513 | begin 514 | case ResponseType of 515 | rtSuccess: 516 | s := SOAuth2AccessAuthorized; 517 | rtError: 518 | s := SOAuth2AccessFailed; 519 | rtIgnored: 520 | s := SOAuth2RequestIgnored; 521 | rtRedirect: 522 | s := BuildImplicitGrantRedirectPage; 523 | end; 524 | AResponseInfo.ContentStream.WriteBuffer(s[1],length(s)); 525 | end; 526 | AResponseInfo.ContentStream.Position := 0; 527 | end; 528 | 529 | procedure TOAuth2Client.HandleDisconnect(AContext: TIdContext); 530 | begin 531 | if FAuthGrantState = agWaitSessionEnd then 532 | FResponseHandler.GrantCompleted; 533 | end; 534 | 535 | procedure TOAuth2Client.GetAccessTokenFromAuthCode(AuthCode: string; 536 | Response: TOAuth2TokenResponse); 537 | var Params: TStringList; 538 | begin 539 | {RFC 6749 Access Token Request} 540 | Params := TStringList.Create; 541 | try 542 | Params.Values['grant_type'] := 'authorization_code'; 543 | Params.Values['code'] := AuthCode; 544 | Params.Values['redirect_uri'] := RedirectURI; 545 | Post(TokenEndPoint,Params,Response); 546 | finally 547 | Params.free; 548 | end; 549 | end; 550 | 551 | function TOAuth2Client.Post(URL: string; Params: TStrings; 552 | Response: TOAuth2Response): integer; 553 | var httpClient: TIdHttp; 554 | SSlHandler: TIdSSLIOHandlerSocketOpenSSL; 555 | RequestParams: TOAuth2URLEncodedData; 556 | ResponseStream: TOAuth2TextBuffer; 557 | begin 558 | SSlHandler := nil; 559 | RequestParams := TOAuth2URLEncodedData.Create; 560 | httpClient := TIdHTTP.Create(nil); 561 | try 562 | httpClient.HTTPOptions := httpClient.HTTPOptions + [hoNoProtocolErrorException, 563 | hoKeepOrigProtocol, 564 | hoWantProtocolErrorContent]; 565 | httpClient.ProtocolVersion := pv1_1; 566 | httpClient.Request.CustomHeaders.Clear; 567 | httpClient.Request.Accept := rcAccept; 568 | case ClientAuthType of 569 | caInline: 570 | begin 571 | httpClient.Request.BasicAuthentication := false; 572 | RequestParams.AddParam('client_id',ClientID); 573 | RequestParams.AddParam('client_secret',ClientSecret); 574 | end; 575 | 576 | caBasic: 577 | begin 578 | httpClient.Request.BasicAuthentication:= true; 579 | httpClient.Request.UserName := ClientID; 580 | httpClient.Request.Password := ClientSecret; 581 | end; 582 | end; 583 | RequestParams.AddParams(Params); 584 | httpClient.Request.UserAgent :=' Mozilla/5.0 (compatible; Indy Library)'; 585 | httpClient.Request.ContentType := 'application/x-www-form-urlencoded'; 586 | if ParseURI(URL).Protocol = 'https' then 587 | begin 588 | SSlHandler := TIdSSLIOHandlerSocketOpenSSL.Create(httpClient); 589 | {$IFDEF USING_INDY10_6} 590 | SSlHandler.SSLOptions.Method := sslvTLSv1_2; 591 | {$ENDIF} 592 | SSlHandler.SSLOptions.Mode:= sslmClient; 593 | httpClient.IOHandler := SSlHandler; 594 | end; 595 | httpClient.ConnectTimeout := 5000; 596 | httpClient.ReadTimeout := 5000; 597 | ResponseStream := TOAuth2TextBuffer.Create; 598 | try 599 | httpClient.Post(URL,RequestParams,ResponseStream); 600 | Result := httpClient.ResponseCode; 601 | if Result = 200 then 602 | Response.ParseJsonResponse(ResponseStream.DataString) 603 | else 604 | raise EOAuth2Exception.Create(Result,httpClient.ResponseText,ResponseStream.DataString); 605 | finally 606 | ResponseStream.Free; 607 | end; 608 | finally 609 | httpClient.Free; 610 | if RequestParams <> nil then RequestParams.Free; 611 | end; 612 | end; 613 | 614 | procedure TOAuth2Client.ResetServer; 615 | begin 616 | FServer.Active := false; 617 | FAuthGrantState := agIdle; 618 | end; 619 | 620 | procedure TOAuth2Client.setRedirectURI(AValue: string); 621 | var URI: TURI; 622 | begin 623 | if FRedirectURI = AValue then Exit; 624 | URI := ParseURI(AValue,'http',PortNo); 625 | URI.Params := ''; 626 | URI.Bookmark := ''; 627 | FRedirectURI := EncodeURI(URI); 628 | FSettingPort := true; 629 | try 630 | PortNo := URI.Port; 631 | finally 632 | FSettingPort := false; 633 | end; 634 | end; 635 | 636 | function TOAuth2Client.BuildImplicitGrantRedirectPage: string; 637 | begin 638 | Result := '<html><body>'+ 639 | '<noscript>' + SNoJavascriptSupport + '</noscript>'+ 640 | '<script>' + RedirectResponse + '</script>' + 641 | '</body></html>'; 642 | end; 643 | 644 | constructor TOAuth2Client.Create(aComponent: TComponent); 645 | begin 646 | inherited Create(aComponent); 647 | FServer := TIdHTTPServer.Create(self); 648 | FServer.OnCommandGet := @HandleCommandGet; 649 | FServer.OnDisconnect := @HandleDisconnect; 650 | FServer.MaxConnections := 1; 651 | FAuthGrantState := agIdle; 652 | FClientAuthType := caInline; 653 | RedirectURI := 'http://localhost:8080'; 654 | end; 655 | 656 | destructor TOAuth2Client.Destroy; 657 | begin 658 | if FServer <> nil then 659 | FServer.Free; 660 | if FResponseHandler <> nil then FResponseHandler.Free; 661 | inherited Destroy; 662 | end; 663 | 664 | procedure TOAuth2Client.GrantClientCredentials(Scope: string; 665 | var AccessToken: string; var TokenScope: string; 666 | var expires_in: integer); 667 | var Response: TOAuth2BearerTokenResponse; 668 | begin 669 | Response := TOAuth2BearerTokenResponse.Create; 670 | try 671 | GrantClientCredentials(Scope,Response); 672 | AccessToken := Response.access_token; 673 | expires_in := Response.expires_in; 674 | TokenScope := Response.scope; 675 | finally 676 | Response.Free; 677 | end; 678 | end; 679 | 680 | procedure TOAuth2Client.GrantClientCredentials(Scope: string; 681 | Response: TOAuth2TokenResponse); 682 | var Params: TStringList; 683 | begin 684 | {RFC 6749 Client Credentials grant} 685 | Params := TStringList.Create; 686 | try 687 | Params.Values['grant_type'] := 'client_credentials'; 688 | if Scope <> '' then 689 | Params.Values['scope'] := Scope; 690 | Post(TokenEndPoint,Params,Response); 691 | finally 692 | Params.free; 693 | end; 694 | end; 695 | 696 | procedure TOAuth2Client.GrantUserPasswordCredentials(Scope: string; UserName, 697 | Password: string; var AccessToken: string; var RefreshToken: string; 698 | var TokenScope: string; var expires_in: integer); 699 | var Response: TOAuth2BearerTokenResponse; 700 | begin 701 | Response := TOAuth2BearerTokenResponse.Create; 702 | try 703 | GrantUserPasswordCredentials(Scope,UserName, Password,Response); 704 | AccessToken := Response.access_token; 705 | RefreshToken := Response.refresh_token; 706 | expires_in := Response.expires_in; 707 | TokenScope := Response.scope; 708 | finally 709 | Response.Free; 710 | end; 711 | end; 712 | 713 | procedure TOAuth2Client.GrantUserPasswordCredentials(Scope: string; UserName, 714 | Password: string; Response: TOAuth2TokenResponse); 715 | var Params: TStringList; 716 | begin 717 | {RFC 6749 Resource Owner Password Credentials Grant} 718 | Params := TStringList.Create; 719 | try 720 | Params.Values['grant_type'] :='password'; 721 | if Scope <> '' then 722 | Params.Values['scope'] := Scope; 723 | Params.Values['username'] := UserName; 724 | Params.Values['password'] := Password; 725 | Post(TokenEndPoint,Params,Response); 726 | finally 727 | Params.free; 728 | end; 729 | end; 730 | 731 | procedure TOAuth2Client.InternalGrantAuthorizationCode(Scope: string); 732 | var URI: TIdURI; 733 | Params: TOAuth2URLEncodedData; 734 | guid: TGUID; 735 | begin 736 | {RFC 6749 Authorization Code Grant} 737 | if FAuthGrantState <> agIdle then 738 | OAuth2Error(erOAuth2ClientNotIdle); 739 | 740 | {Assume ResponseHandler already set up} 741 | FAuthGrantState := agWaitAuthCode; 742 | URI := TIdURI.Create(AuthEndPoint); 743 | Params := TOAuth2URLEncodedData.Create; 744 | try 745 | Params.AddParam('response_type','code'); 746 | Params.AddParam('client_id',ClientID); 747 | if Scope <> '' then 748 | Params.AddParam('scope',Scope); 749 | if CreateGUID(guid) <> 0 then 750 | OAuth2Error(erCreateGuidFailed); 751 | FState := GUIDToString(guid); 752 | Params.AddParam('state',FState); 753 | Params.AddParam('redirect_uri',RedirectURI); 754 | URI.Params := Params.DataString; 755 | if OpenURL(URI.GetFullURI) then 756 | FServer.Active := true 757 | else 758 | OAuth2Error(erOpenURLFailed,[URI.GetFullURI]); 759 | finally 760 | URI.Free; 761 | Params.Free; 762 | end; 763 | end; 764 | 765 | {Asynchromous - response is processed by HTTP Server OnCommandGet} 766 | procedure TOAuth2Client.GrantAuthorizationCodeAsync(Scope: string; 767 | ResponseClass: TOAuth2TokenResponseClass); 768 | begin 769 | CheckMainThread; 770 | FResponseHandler := TAsyncResponseHandler.Create(self,ResponseClass); 771 | InternalGrantAuthorizationCode(Scope); 772 | end; 773 | 774 | {Asynchromous - response is processed by HTTP Server OnCommandGet} 775 | procedure TOAuth2Client.GrantAuthorizationCodeAsync(Scope: string); 776 | begin 777 | GrantAuthorizationCodeAsync(Scope,TOAuth2BearerTokenResponse); 778 | end; 779 | 780 | procedure TOAuth2Client.GrantAuthorizationCode(Scope: string; var AccessToken, 781 | RefreshToken: string; var TokenScope: string; var expires_in: integer; 782 | timeout: cardinal); 783 | var Response: TOAuth2BearerTokenResponse; 784 | begin 785 | Response := TOAuth2BearerTokenResponse.Create; 786 | try 787 | GrantAuthorizationCode(Scope, Response, timeout); 788 | AccessToken := Response.access_token; 789 | RefreshToken := Response.refresh_token; 790 | expires_in := Response.expires_in; 791 | TokenScope := Response.scope; 792 | finally 793 | Response.Free; 794 | end; 795 | end; 796 | 797 | procedure TOAuth2Client.GrantAuthorizationCode(Scope: string; 798 | Response: TOAuth2TokenResponse; timeout: cardinal); 799 | begin 800 | FResponseHandler := TSyncResponseHandler.Create(self,Response); 801 | try 802 | InternalGrantAuthorizationCode(Scope); 803 | with TSyncResponseHandler(FResponseHandler) do 804 | begin 805 | if WaitFor(timeout) = wrTimeout then 806 | OAuth2Error(erAuthTimeout); 807 | end; 808 | finally 809 | FResponseHandler.Free; 810 | end; 811 | end; 812 | 813 | procedure TOAuth2Client.ImplicitGrantAsync(Scope: string); 814 | begin 815 | ImplicitGrantAsync(Scope,TOAuth2BearerTokenResponse); 816 | end; 817 | 818 | procedure TOAuth2Client.InternalImplicitGrant(Scope: string); 819 | var URI: TIdURI; 820 | Params: TOAuth2URLEncodedData; 821 | guid: TGUID; 822 | begin 823 | {RFC 6749 Implicit Grant} 824 | if FAuthGrantState <> agIdle then 825 | OAuth2Error(erOAuth2ClientNotIdle); 826 | 827 | {Assume Response Handler already setup} 828 | FAuthGrantState := agWaitAccessCode; 829 | URI := TIdURI.Create(AuthEndPoint); 830 | Params := TOAuth2URLEncodedData.Create; 831 | try 832 | Params.AddParam('response_type','token'); 833 | Params.AddParam('client_id',ClientID); 834 | if Scope <> '' then 835 | Params.AddParam('scope',Scope); 836 | if CreateGUID(guid) <> 0 then 837 | OAuth2Error(erCreateGuidFailed); 838 | FState := GUIDToString(guid); 839 | Params.AddParam('state',FState); 840 | Params.AddParam('redirect_uri',RedirectURI); 841 | URI.Params := Params.DataString; 842 | if OpenURL(URI.GetFullURI) then 843 | FServer.Active := true 844 | else 845 | OAuth2Error(erOpenURLFailed,[URI.GetFullURI]); 846 | finally 847 | URI.Free; 848 | Params.Free; 849 | end; 850 | end; 851 | 852 | procedure TOAuth2Client.ImplicitGrantAsync(Scope: string; 853 | ResponseClass: TOAuth2TokenResponseClass); 854 | begin 855 | CheckMainThread; 856 | FResponseHandler := TAsyncResponseHandler.Create(self,ResponseClass); 857 | InternalImplicitGrant(Scope); 858 | end; 859 | 860 | procedure TOAuth2Client.ImplicitGrant(Scope: string; Response: TOAuth2TokenResponse; 861 | timeout: cardinal); 862 | begin 863 | FResponseHandler := TSyncResponseHandler.Create(self,Response); 864 | try 865 | InternalImplicitGrant(Scope); 866 | with TSyncResponseHandler(FResponseHandler) do 867 | begin 868 | if WaitFor(timeout) = wrTimeout then 869 | OAuth2Error(erAuthTimeout); 870 | end; 871 | finally 872 | FreeAndNil(FResponseHandler); 873 | end; 874 | end; 875 | 876 | procedure TOAuth2Client.ImplicitGrant(Scope: string; var AccessToken: string; 877 | var TokenScope: string; var expires_in: integer; timeout: cardinal); 878 | var Response: TOAuth2BearerTokenResponse; 879 | begin 880 | Response := TOAuth2BearerTokenResponse.Create; 881 | try 882 | ImplicitGrant(Scope, Response, timeout); 883 | AccessToken := Response.access_token; 884 | expires_in := Response.expires_in; 885 | TokenScope := Response.scope; 886 | finally 887 | Response.Free; 888 | end; 889 | end; 890 | 891 | procedure TOAuth2Client.CancelGrantRequest; 892 | begin 893 | ResetServer; 894 | end; 895 | 896 | procedure TOAuth2Client.RefreshAccessToken(Scope, RefreshToken: string; 897 | var AccessToken: string; var TokenScope: string; var NewRefreshToken: string; 898 | var expires_in: integer); 899 | var Response: TOAuth2BearerTokenResponse; 900 | begin 901 | Response := TOAuth2BearerTokenResponse.Create; 902 | try 903 | RefreshAccessToken(Scope,RefreshToken,Response); 904 | AccessToken := Response.access_token; 905 | NewRefreshToken := Response.refresh_token; 906 | expires_in := Response.expires_in; 907 | TokenScope := Response.scope; 908 | finally 909 | Response.Free; 910 | end; 911 | end; 912 | 913 | procedure TOAuth2Client.RefreshAccessToken(Scope, RefreshToken: string; 914 | Response: TOAuth2TokenResponse); 915 | var Params: TStringList; 916 | begin 917 | Params := TStringList.Create; 918 | try 919 | Params.Values['grant_type'] := 'refresh_token'; 920 | if Scope <> '' then 921 | Params.Values['scope'] := Scope; 922 | Params.Values['refresh_token'] := RefreshToken; 923 | Post(TokenEndPoint,Params,Response); 924 | finally 925 | Params.free; 926 | end; 927 | end; 928 | 929 | procedure TOAuth2Client.ExtensionGrant(GrantType: string; aParams: TStrings; 930 | Response: TOAuth2TokenResponse); 931 | var Params: TStringList; 932 | begin 933 | Params := TStringList.Create; 934 | try 935 | Params.Values['grant_type'] := GrantType; 936 | Params.AddStrings(aParams); 937 | Post(TokenEndPoint,Params,Response); 938 | finally 939 | Params.free; 940 | end; 941 | end; 942 | 943 | procedure Register; 944 | begin 945 | RegisterComponents('OAuth2',[TOAuth2Client]); 946 | end; 947 | 948 | initialization 949 | {$I oauth2client.lrs} 950 | 951 | end. 952 | 953 | -------------------------------------------------------------------------------- /src/oauth2client.lrs: -------------------------------------------------------------------------------- 1 | LazarusResources.Add('TOAuth2Client','PNG',[ 2 | #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0' '#0#0#0' '#8#6#0#0#0'szz'#244#0#0 3 | +#1#133'iCCPICC profile'#0#0'('#145'}'#145'=H'#195'P'#20#133'O['#165'E+'#14'v' 4 | +#16'q'#200#208':Y'#16#21#17''''#173'B'#17'*'#132'Z'#161'U'#7#147#151#254'A' 5 | +#147#134'$'#197#197'Qp-8'#248#179'Xupq'#214#213#193'U'#16#4#127'@'#220#220 6 | +#156#20']'#164#196#251#146'B'#139#24#31'\'#222#199'y'#239#28#238#187#15#240 7 | +'7*L5'#187#198#0'U'#179#140't2!ds'#171'B'#240#21'!'#244'R'#197'0#1S'#159#19 8 | +#197#20'<'#215#215'=||'#191#139#243','#239'{'#127#174'>%o2'#192''''#16#207'2' 9 | +#221#176#136'7'#136#167'6-'#157#243'>q'#132#149'$'#133#248#156'x'#212#160#6 10 | +#137#31#185'.'#187#252#198#185#232#176#159'gF'#140'Lz'#158'8B,'#20';X'#238'`' 11 | +'V2T'#226'I'#226#168#162'j'#148#239#207#186#172'p'#222#226#172'Vj'#172#213 12 | +''''#127'a8'#175#173',s'#157'j'#24'I,b'#9'"'#4#200#168#161#140#10','#196'i' 13 | +#215'H1'#145#166#243#132#135#127#200#241#139#228#146#201'U'#6'#'#199#2#170'P' 14 | +'!9~'#240'?'#248'=['#179'01'#238'&'#133#19'@'#247#139'm'#127#196#128#224'.' 15 | +#208#172#219#246#247#177'm7O'#128#192'3p'#165#181#253#213#6'0'#253'Iz'#189 16 | +#173'E'#143#128#254'm'#224#226#186#173#201'{'#192#229#14'0'#248#164'K'#134 17 | +#228'H'#1'*'#127#161#0#188#159#209'7'#229#128#129'['#160'g'#205#157'['#235#28 18 | +#167#15'@'#134'f'#149#186#1#14#14#129#145'"e'#175'{'#188';'#212'9'#183#127 19 | +#239#180#230#247#3#157'$r'#184#8#208#135#26#0#0#0#6'bKGD'#0'A'#0#25#0#240'2' 20 | +#154#160'e'#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7 21 | +#229#8#11#8'2'#0#142'O'#233#152#0#0#0#25'tEXtComment'#0'Created with GIMPW' 22 | +#129#14#23#0#0#4'$IDATX'#195#229#151']h\U'#16#199#127'sn'#238'~''7Ml'#201'WC' 23 | +#193'J'#10'mQl'#241'Aj'#213'M'#169#8#22'E'#132#154'T'#212'"'#138'`'#31'|Q' 24 | +#154#151'R?'#192#146''''#31'DD'#11'bi'#179#198#22#196#138'J)'#221'j'#169'`|' 25 | +#240'AEb'#19#130#130'Y'#165#27#178'Y'#146'l7{'#247#158#227#195#222#212't'#155 26 | +#221'l'#186#129'>8p'#184#151's/3'#255'3'#243#159'93b'#140#225'v'#138#226'6KC' 27 | +#165#15#241#206'l'#24'C'#15'`'#213'mE'#24'MN:'#243#203'~*'#15'A'#188'3'#27 28 | +#195'p'#12'x'#17#240#128#223#253#231#173#202#22' '#8#12#3#175'&S'#206'TE'#0 29 | +#189#157#217#6'c'#184#12'l'#5#14'#|'#148#156't'#10#245#28#190#183'+'#219'`4' 30 | +#251#129'w'#129#12#194#189#201'Ign'#217#16#24#195'!`'#7#176'+'#153'rF'#214'"' 31 | +#198#23#254'r'#138#192#169'xG'#246'G'#224''''#12'G'#128#215'+'#145#176#31'x' 32 | +#175#154#241#233#132#236#154'NH'#239'j'#129'$S'#206#24#240'&'#208#191#187'q' 33 | +#166'"'#9#187#128#161#10#134#239#2#230'"'#173#237#23#197'Rj:![Z'#250#204#216 34 | +'*q'#12#1#131'VT'#170#166#225'd'#249#198#204#233#192'@'#172'm'#227#21'e'#7'>' 35 | +#176#2'v'#131#178'm'#5'<1'#247'e'#203#185#233#132#196'k'#181#174']&'#129#15 36 | +#209'5'#164'!@'#230#180#8#130#216#193#166#187#3#177#8#11#179#225#251#144#18 37 | +'z+'#24'>'#20'k'#219#208'='#247#143')'#0#201#26#236'o'#251'6'#237'<'#230#186 38 | +#166'`'#219'r'#4'8'#9'LT'#4#240#231'I'#145#150'X'#211#136#10#4#187#180#187'0' 39 | +#238'o['#0#162#4#17#229#148#242'H'#217'+'#24#14#251#25#240#18#128'm'#11'@'#26 40 | +'8^'#213#3#141'B'#208#14#135#182#219#177'Xh>'#157#15#2#136#168#232#127#9',' 41 | +#129#26'N'#189#1#248#10#216#185'd/'#15#236#3'RUK'#177#5#174'1'#184#148#234'D' 42 | +#216#223#14#137#146'Z'#203'x'#27'p'#169#204#184#185'2'#234#190#253#208#29#217 43 | +#145#149'9`'#0#163#193'x '#226#3'0'#202#247#4#160'|'#175'H'#16' 3$'#150#17 44 | +#182#26#200#180#246#153#12#240#13#208'S'#166#245#240#203#241#28#162'j '#161 45 | +'h4'#198#211#130#198#178'Ka'#182#2'!D)D'#9'V0'#184'X'#189'd:!VC('#240'u8'#26 46 | +#221'['#200';9'#224#7#224#158'2'#149#199#31'n'#203#14#138'b'#22#197#224#138 47 | +'nlz'#214#24#163#139'Z'#137'!'#218#28#3#207'%'#220#28#195#178'-'#148'%D['#28 48 | +#240'\0'#30'b'#169#215#162'N'#211'^'#208'&p'#255#249#159#129#242#212#252#14 49 | +'x'#197#127#143#213't'#27#150#18#215'+'#224#21#193#24#208#30'('#5#248#28#136 50 | +#29#192'['#247'('#13#235#221#7#130#19'O'#237'F{x'#155#206#156#8#173#223#252 51 | +'\'#153#150#9#224'I'#160#176#170#235#184#228'^'#207'-'#157'R'#131'('#208#2'"' 52 | +#176#233'c'#216#248#8'V'#137#172#138#169'~r'#179#185'?"={'#246#149'i'#152#245 53 | +#25'?'#189#234'~'#160#228#1'}m'#209#205#136#226':{'#26'7'#223#136#179#251'yB' 54 | +#205'w.'#0'-e4~'#6#248#237#150#26#18#223#3#215#240#10#160#213#13#0'L.'#131'4' 55 | +'/!l'#251#14#228'f'#198#191#5#156#173#171'%+zf'#28#207#5#175#224#175#5#240#10 56 | +#200#204#232'Jz'#207#3'G'#235#238#9#139'E'#243'~'#193'5'#26#163'A'#23#185#14 57 | +'&u'#166#196#139#229#229'o'#255'Z7u'#3'h'#233'3'#23#230#243#230'`.O'#218#245 58 | +'@k'#208#6#138#185#179#232#244'X%'#3#7#129#169#186#155#210'EY'#247#180'9'#145 59 | +'I'#200'p'#190#192'N'#160#219#7#157'n'#10'4F'#20'|^'#246#251''''#192#185'z' 60 | +#187#226#200'M '#250#204#2#240#189#191#150#202#0#240#184#239#238#203#192#27 61 | +'U'#155'c'#139'Py`'#202#1#204#3#15#2#227'5'#30#224#152#191'j'#19'C'#28#200'/' 62 | +'mH'#212'2%s '#222#153#141#172#245#0#210#219#157'U~f$/^u*'#2'x'#7'h'#199#240 63 | +'E'#188'#'#219#186'V'#198#227#157#217#152')'#146#240';'#238#163#213#7#147#142 64 | +#236#30#224'S'#192#6'N'#1#191#212'9'#152'l'#3#246#251#220'z!'#153'r>'#171#10 65 | +#192#7#209#4#28#0#182#175#201'h'#6#191#2#195#201#148'su'#197#209#236#127'7' 66 | ,#29#255#11#207#188'v}A'#145#21'8'#0#0#0#0'IEND'#174'B`'#130 67 | ]); 68 | -------------------------------------------------------------------------------- /src/oauth2errors.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the MWA Software OAuth2 Client. 3 | 4 | The MWA Software OAuth2 Client is free software: you can redistribute it 5 | and/or modify it under the terms of the GNU Lesser General Public License as 6 | published by the Free Software Foundation, either version 3 of the License, or 7 | (at your option) any later version. 8 | 9 | The MWA Software OAuth2 Client is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU Lesser General Public License for more details. 13 | 14 | You should have received a copy of the GNU Lesser General Public License 15 | along with the MWA Software OAuth2 Client. If not, see <https://www.gnu.org/licenses/>. 16 | } 17 | 18 | unit oauth2errors; 19 | 20 | {$mode objfpc}{$H+} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, oauth2tokens; 26 | 27 | type 28 | TOAuth2ErrorCodes = ( 29 | erUnexpectedState, 30 | erMissingAuthCode, 31 | erBadAccessTokenType, 32 | erCreateGuidFailed, 33 | erOpenURLFailed, 34 | erAuthTimeout, 35 | erOAuth2ClientNotIdle, 36 | erMissingAccessToken, 37 | erInvalidPropertyType, 38 | erNotMainThread 39 | ); 40 | 41 | TOAuth2Errors = (oeInvalidRequest, {The request is missing a required parameter, includes an 42 | unsupported parameter value (other than grant type), 43 | repeats a parameter, includes multiple credentials, 44 | utilizes more than one mechanism for authenticating the 45 | client, or is otherwise malformed.} 46 | 47 | oeInvalidClient, {Client authentication failed (e.g., unknown client, no 48 | client authentication included, or unsupported 49 | authentication method). The authorization server MAY 50 | return an HTTP 401 (Unauthorized) status code to indicate 51 | which HTTP authentication schemes are supported. If the 52 | client attempted to authenticate via the "Authorization" 53 | request header field, the authorization server MUST 54 | respond with an HTTP 401 (Unauthorized) status code and 55 | include the "WWW-Authenticate" response header field 56 | matching the authentication scheme used by the client.} 57 | 58 | oeInvalidGrant, {The provided authorization grant (e.g., authorization 59 | code, resource owner credentials) or refresh token is 60 | invalid, expired, revoked, does not match the redirection 61 | URI used in the authorization request, or was issued to 62 | another client.} 63 | 64 | oeInvalidAuthClient, {The authenticated client is not authorized to use this 65 | authorization grant type.} 66 | 67 | oeUnsupportedGrant, {The authorization grant type is not supported by the 68 | authorization server} 69 | 70 | oeInvalidScope, {The requested scope is invalid, unknown, malformed, or 71 | exceeds the scope granted by the resource owner.} 72 | 73 | oeUnknown); {none of the above} 74 | 75 | TOAuth2ErrorData = record 76 | StatusCode: integer; 77 | ErrorMessage: string; 78 | ErrorCode: TOAuth2Errors; 79 | Error: string; 80 | Description: string; 81 | ErrorURI: string; 82 | end; 83 | 84 | EOAuth2ClientError = class(Exception); 85 | 86 | { EOAuth2Exception } 87 | 88 | EOAuth2Exception = class(EOAuth2ClientError) 89 | private type 90 | 91 | { TErrorInfo } 92 | 93 | TErrorInfo = class(TOAuth2Response) 94 | { Example Error Response - JSON encoded 95 | "error":"invalid_request" 96 | } 97 | private 98 | FError: string; 99 | FErrorDescription: string; 100 | FErrorURI: string; 101 | protected 102 | procedure ValidateResponse; override; 103 | public 104 | constructor Create(responseStr: string); overload; 105 | constructor Create(Params: TStrings); overload; 106 | published 107 | property error: string read FError write FError; 108 | property error_description: string read FErrorDescription write FErrorDescription; 109 | property error_uri: string read FErrorURI write FErrorURI; 110 | end; 111 | 112 | private 113 | FErrorCode: TOAuth2Errors; 114 | FErrorResponse: TErrorInfo; 115 | FStatusCode: integer; 116 | function GetDescription: string; 117 | function GetError: string; 118 | function GetErrorURI: string; 119 | procedure SetErrorCode(theError: string); 120 | public 121 | constructor Create(StatusCode: integer; responseText, responseBody: string); overload; 122 | constructor Create(Params: TStrings); overload; 123 | constructor Create(data: TOAuth2ErrorData); overload; 124 | destructor Destroy; override; 125 | procedure GetErrorData(var data: TOAuth2ErrorData); 126 | property StatusCode: integer read FStatusCode; 127 | property ErrorCode: TOAuth2Errors read FErrorCode; 128 | property Error: string read GetError; 129 | property Description: string read GetDescription; 130 | property ErrorURI: string read GetErrorURI; 131 | end; 132 | 133 | procedure OAuth2Error(ErrorCode: TOAuth2ErrorCodes; args: array of const); overload; 134 | procedure OAuth2Error(ErrorCode: TOAuth2ErrorCodes); overload; 135 | 136 | implementation 137 | 138 | uses fpjsonrtti; 139 | 140 | resourcestring 141 | {Used with EOAuth2Exception} 142 | SOAuth2ResponseError = 'Status Code %d %s - OAuth2 Error (%s) %s'; 143 | SOuth2OtherException = 'Status Code %d - Unknown OAuth2 Error'; 144 | SOAuthErrorMessage = 'Authorisation Code Request Error - %s - %s'; 145 | 146 | {used with EOauth2ClientError} 147 | SUnexpectedState = 'Unexpected State Parameter - attempt at forgery? Expected "%s", received "%s"'; 148 | SMissingAuthCode = 'No Authorisation Code contained in response to authorisation code request'; 149 | SBadAccessTokenType = 'Unexpected Access Token Type - expected %s found %s'; 150 | SCreateGuidFailed = 'Create GUID Failed'; 151 | SOpenURLFailed = 'Call to OpenURL Failed for %s'; 152 | SAuthTimeout = 'Authorization Grant Timeout'; 153 | SOAuth2ClientNotIdle = 'OAuth2 Client is not idle'; 154 | SMissingAccessToken = 'Access Token not present in response'; 155 | SInvalidPropertyType = 'Unsupported property type or value for property %s - value = "%s"'; 156 | SNotMainThread = 'Method must be called from the main thread only'; 157 | 158 | const 159 | OAuth2ErrorMessages: array [TOAuth2ErrorCodes] of string = ( 160 | SUnexpectedState, 161 | SMissingAuthCode, 162 | SBadAccessTokenType, 163 | SCreateGuidFailed, 164 | SOpenURLFailed, 165 | SAuthTimeout, 166 | SOAuth2ClientNotIdle, 167 | SMissingAccessToken, 168 | SInvalidPropertyType, 169 | SNotMainThread 170 | ); 171 | 172 | function GetErrorMessage(ErrorCode: TOAuth2ErrorCodes): string; 173 | begin 174 | Result := OAuth2ErrorMessages[ErrorCode]; 175 | end; 176 | 177 | 178 | procedure OAuth2Error(ErrorCode: TOAuth2ErrorCodes; args: array of const); 179 | begin 180 | raise EOAuth2ClientError.CreateFMT(GetErrorMessage(ErrorCode),args); 181 | end; 182 | 183 | procedure OAuth2Error(ErrorCode: TOAuth2ErrorCodes); 184 | begin 185 | OAuth2Error(Errorcode,[nil]); 186 | end; 187 | 188 | { EOAuth2Exception.TErrorInfo } 189 | 190 | procedure EOAuth2Exception.TErrorInfo.ValidateResponse; 191 | begin 192 | //do nothing 193 | end; 194 | 195 | constructor EOAuth2Exception.TErrorInfo.Create(responseStr: string); 196 | begin 197 | inherited Create; 198 | ParseJsonResponse(responseStr); 199 | end; 200 | 201 | constructor EOAuth2Exception.TErrorInfo.Create(Params: TStrings); 202 | begin 203 | inherited Create; 204 | ProcessParams(Params); 205 | end; 206 | 207 | { EOAuth2Exception } 208 | 209 | function EOAuth2Exception.GetDescription: string; 210 | begin 211 | Result := FErrorResponse.FErrorDescription; 212 | end; 213 | 214 | function EOAuth2Exception.GetError: string; 215 | begin 216 | Result := FErrorResponse.error; 217 | end; 218 | 219 | function EOAuth2Exception.GetErrorURI: string; 220 | begin 221 | Result := FErrorResponse.error_uri; 222 | end; 223 | 224 | procedure EOAuth2Exception.SetErrorCode(theError: string); 225 | begin 226 | FErrorCode := oeUnknown; 227 | if theError = 'invalid_request' then 228 | FErrorCode := oeInvalidRequest 229 | else 230 | if theError = 'invalid_client' then 231 | FErrorCode := oeInvalidClient 232 | else 233 | if theError = 'invalid_grant' then 234 | FErrorCode := oeInvalidGrant 235 | else 236 | if theError = 'unauthorized_client' then 237 | FErrorCode := oeInvalidAuthClient 238 | else 239 | if theError = 'oeUnsupportedGrant' then 240 | FErrorCode := oeInvalidAuthClient 241 | else 242 | if theError = 'invalid_scope' then 243 | FErrorCode := oeInvalidScope; 244 | end; 245 | 246 | constructor EOAuth2Exception.Create(StatusCode: integer; responseText, 247 | responseBody: string); 248 | begin 249 | FStatusCode := StatusCode; 250 | FErrorResponse := TErrorInfo.Create(responseBody); 251 | if StatusCode = 400 {Bad Request} then 252 | begin 253 | inherited CreateFmt(SOAuth2ResponseError,[StatusCode,responseText, 254 | FErrorResponse.error, 255 | FErrorResponse.error_description]); 256 | SetErrorCode(FErrorResponse.error); 257 | end 258 | else 259 | inherited CreateFmt(SOuth2OtherException,[StatusCode]); 260 | end; 261 | 262 | constructor EOAuth2Exception.Create(Params: TStrings); 263 | begin 264 | FErrorResponse := TErrorInfo.Create(Params); 265 | inherited CreateFmt(SOAuthErrorMessage,[FErrorResponse.error, 266 | FErrorResponse.error_description]); 267 | SetErrorCode(FErrorResponse.error); 268 | end; 269 | 270 | constructor EOAuth2Exception.Create(data: TOAuth2ErrorData); 271 | begin 272 | FStatusCode := data.StatusCode; 273 | FErrorCode := data.ErrorCode; 274 | FErrorResponse.error := data.Error; 275 | FErrorResponse.error_description := data.Description; 276 | FErrorResponse.error_uri := data.ErrorURI; 277 | inherited Create(data.ErrorMessage); 278 | end; 279 | 280 | destructor EOAuth2Exception.Destroy; 281 | begin 282 | if FErrorResponse <> nil then 283 | FErrorResponse.free; 284 | inherited Destroy; 285 | end; 286 | 287 | procedure EOAuth2Exception.GetErrorData(var data: TOAuth2ErrorData); 288 | begin 289 | data.StatusCode := StatusCode; 290 | data.ErrorMessage := Message; 291 | data.ErrorCode := ErrorCode; 292 | data.Error := Error; 293 | data.Description := Description; 294 | data.ErrorURI := ErrorURI; 295 | end; 296 | 297 | 298 | end. 299 | 300 | -------------------------------------------------------------------------------- /src/oauth2tokens.pas: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the MWA Software OAuth2 Client. 3 | 4 | The MWA Software OAuth2 Client is free software: you can redistribute it 5 | and/or modify it under the terms of the GNU Lesser General Public License as 6 | published by the Free Software Foundation, either version 3 of the License, or 7 | (at your option) any later version. 8 | 9 | The MWA Software OAuth2 Client is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU Lesser General Public License for more details. 13 | 14 | You should have received a copy of the GNU Lesser General Public License 15 | along with the MWA Software OAuth2 Client. If not, see <https://www.gnu.org/licenses/>. 16 | } 17 | 18 | unit oauth2tokens; 19 | 20 | {$mode objfpc}{$H+} 21 | 22 | interface 23 | 24 | uses Classes, Sysutils, fpjson; 25 | 26 | type 27 | { TOAuth2Response } 28 | 29 | TOAuth2Response = class(TPersistent) 30 | protected 31 | procedure ValidateResponse; virtual; abstract; 32 | public 33 | procedure ParseJsonResponse(response: TJSONStringType); 34 | procedure ProcessParams(Params: TStrings); 35 | end; 36 | 37 | { TOAuth2TokenResponse } 38 | 39 | TOAuth2TokenResponse = class(TOAuth2Response) 40 | private 41 | FTokenType: string; 42 | FTokenTypeName: string; 43 | protected 44 | procedure ValidateResponse; override; 45 | procedure SetTokenTypeName(aTokenTypeName: string); 46 | public 47 | constructor Create; virtual; 48 | property TokenTypeName: string read FTokenTypeName; 49 | published 50 | property token_type: string read FTokenType write FTokenType; 51 | end; 52 | 53 | TOAuth2TokenResponseClass = class of TOAuth2TokenResponse; 54 | 55 | { TOAuth2BearerTokenResponse } 56 | 57 | TOAuth2BearerTokenResponse = class(TOAuth2TokenResponse) 58 | { Example Access Token - JSON encoded 59 | "access_token":"2YotnFZFEjr1zCsicMWpAA", 60 | "token_type":"example", 61 | "expires_in":3600, 62 | "refresh_token":"tGzv3JOkF0XG5Qx2TlKWIA", 63 | "example_parameter":"example_value" 64 | } 65 | private const BearerToken = 'bearer'; 66 | 67 | private 68 | FAccessToken: string; 69 | FExpiresIn: integer; 70 | FRefreshToken: string; 71 | FScope: string; 72 | protected 73 | procedure ValidateResponse; override; 74 | public 75 | constructor Create; override; 76 | published 77 | property access_token: string read FAccessToken write FAccessToken; 78 | property expires_in: integer read FExpiresIn write FExpiresIn; 79 | property refresh_token: string read FRefreshToken write FRefreshToken; 80 | property scope: string read FScope write FScope; 81 | end; 82 | 83 | implementation 84 | 85 | uses fpjsonrtti, RttiUtils, TypInfo, oauth2errors; 86 | 87 | { TOAuth2Response } 88 | 89 | procedure TOAuth2Response.ParseJsonResponse(response: TJSONStringType); 90 | var DeStreamer: TJSONDeStreamer; 91 | begin 92 | DeStreamer := TJSONDeStreamer.Create(nil); 93 | try 94 | DeStreamer.JSONToObject(response,self); 95 | finally 96 | DeStreamer.Free; 97 | end; 98 | ValidateResponse; 99 | end; 100 | 101 | procedure TOAuth2Response.ProcessParams(Params: TStrings); 102 | var i: integer; 103 | PropInfoList : TPropInfoList; 104 | ParamIndex: integer; 105 | begin 106 | PropInfoList := TPropInfoList.Create(self,tkProperties); 107 | try 108 | for i := 0 to PropInfoList.Count - 1 do 109 | begin 110 | ParamIndex := Params.IndexOfName(PropInfoList[i]^.Name); 111 | if ParamIndex <> -1 then 112 | begin 113 | case PropInfoList[i]^.PropType^.Kind of 114 | tkInteger: 115 | SetOrdProp(self,PropInfoList[i],StrToInt(Params.ValueFromIndex[ParamIndex])); 116 | tkInt64: 117 | SetOrdProp(self,PropInfoList[i],StrToInt64(Params.ValueFromIndex[ParamIndex])); 118 | tkFloat: 119 | SetFloatProp(self,PropInfoList[i],StrToFloat(Params.ValueFromIndex[ParamIndex])); 120 | tkSString, 121 | tkLString, 122 | tkAString: 123 | SetStrProp(self,PropInfoList[i],Params.ValueFromIndex[ParamIndex]); 124 | tkBool: 125 | if CompareText(Params.ValueFromIndex[ParamIndex],'true') <> 0 then 126 | SetOrdProp(self,PropInfoList[i],Ord(true)) 127 | else 128 | if CompareText(Params.ValueFromIndex[ParamIndex],'false') <> 0 then 129 | SetOrdProp(self,PropInfoList[i],Ord(false)) 130 | else 131 | OAuth2Error(erInvalidPropertyType,[Params.Names[ParamIndex],Params.ValueFromIndex[ParamIndex]]); 132 | else 133 | OAuth2Error(erInvalidPropertyType,[Params.Names[ParamIndex],Params.ValueFromIndex[ParamIndex]]); 134 | end; 135 | end; 136 | end; 137 | finally 138 | FreeAndNil(PropInfoList); 139 | end; 140 | ValidateResponse; 141 | end; 142 | 143 | { TOAuth2TokenResponse } 144 | 145 | procedure TOAuth2TokenResponse.ValidateResponse; 146 | begin 147 | if CompareText(token_type,TokenTypeName) <> 0 then 148 | OAuth2Error(erBadAccessTokenType,[TokenTypeName,token_type]); 149 | end; 150 | 151 | procedure TOAuth2TokenResponse.SetTokenTypeName(aTokenTypeName: string); 152 | begin 153 | FTokenTypeName := aTokenTypeName; 154 | end; 155 | 156 | constructor TOAuth2TokenResponse.Create; 157 | begin 158 | inherited Create; 159 | end; 160 | 161 | { TOAuth2BearerTokenResponse } 162 | 163 | procedure TOAuth2BearerTokenResponse.ValidateResponse; 164 | begin 165 | inherited; 166 | if access_token = '' then 167 | OAuth2Error(erMissingAccessToken); 168 | end; 169 | 170 | 171 | constructor TOAuth2BearerTokenResponse.Create; 172 | begin 173 | inherited Create; 174 | SetTokenTypeName(BearerToken); 175 | end; 176 | 177 | 178 | 179 | end. 180 | 181 | --------------------------------------------------------------------------------